home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus Special 25
/
AMIGAplus Sonderheft 25 (2000)(Falke)(DE)(Track 1 of 4)[!].iso
/
Magazin
/
Future-PD
/
FinalExistenceSourceCode.asc
< prev
next >
Wrap
Text File
|
1998-06-17
|
97KB
|
3,765 lines
'*****************************************************************************
'The Chrono Trigger Wanna-Be Engine
'By John C. Bintz of Internext Software
'Revision One Zillion+
'Version 1.0h
'Copyright © 1998 John C. Bintz. All Rights Reserved. Death to Microsoft.
'
'This is, in no way whatsoever, connected with Squaresoft of Japan at all.
'This RPG engine behaves in a way like my favorite role playing game engine
'so I'm paying hommage to its parent. I'm not trying to suck money from
'them, nor am I trying to infringe upon anything. Don't sic the lawyers on me
'guys. I'm just trying to make the Amiga world a better place.
'
'This puppy has taken probably around three hundred hours of coding, revising,
'recoding, rerevising, and testing, and it STILL isn't done! What I need is
'a way to draw on the screen. Plus a team of fifty to write all my games
'for me. 8^)
'
'But, now, with the FULLY INTEGRATED EDITOR (well, it just does it all...),
'RPG creation will be a slice of pie, er, piece of cake.
'
'The Force will be with you, Amy. Always. And pray for a PPC Amos someday!
'*****************************************************************************
'Revision List
'=============
'Version 1.0b to 1.0c
'--------------------
'* Added Pointer (AKA Squaresoft!)
'* Caching of Bob Images (VERY fast level loading!)
'* Fixed MAX_ENEMY Bug
'* Fixed Fight Command Bug
'* Changed Text Screens From Separate Screen to Overlay (neat!)
'* Other Stuff That I Forget I Did (but I'm sure it was important!)
'====================
'Version 1.0c to 1.0d
'--------------------
'* Added the absolutely BUFF editor with Hypertexted Help document
'* Hacked MusiCRAFT so I could have GOOD sound
'* Added the SOUND operative so you can sync SOUND EFFECTS
'* CAPITALIZED a couple of things
'====================
'Version 1.0d to 1.0e
'--------------------
'* Updated editor for faster speed and more intuitive use
'* Fixed Frame Displaying, which skipped the first frame on FRAMEANIMs
'* Made certain commands multithreading for maximum speed!
'* Trimmed some arrays for memory saving
'* Allowed for smoother KILLing of objects before level loads
'====================
'Version 1.0e to 1.0f
'--------------------
'* No more loading Amos to find level problems! Error window displays
' problem on Workbench Screen
'====================
'Version 1.0f to 1.0g
'--------------------
'* Small optimizations here and there...
'* Added QUAKE operative (which I ain't afraid of, of course!)
'* Allowed more than 255 bobs in an SBOBS bank (had to rewrite the entire
' frames routine, though...and on my second day off from school, too!)
'* Never use the Trap instruction, especially on a function! It thrashes
' Chip memory, which is always bad! Just be sure your character really
' exists when you use the COORDS command.
'* Changed the FIGHT routine. Now, enemies are gauged in actual HP, ATK,
' DEF, and CHARGE. Plus, there is also a Hit % calc that says you can
' still hit a guy, no matter what strength you are, and still cause damage.
'* Removed defunct "How this works" code...as I know how it works! I wrote
' it, remember? Saved a few K in source code.
'====================
'Version 1.0g to 1.0h
'--------------------
'* DOOM Music Extension! I think I might make the game 020 only, but I might
' also stick in the old Amos routines to make an 000 version. PT Mods play
' back PERFECTLY, with tempo and all! SFX also don't kill the system.
'* Forced Game Saving routine to stick '.game' onto end of game titles
' without the extension
Set Buffer 20
Amos To Back
CMND$=Command Line$
Screen Open 0,320,200,2,Lowres : Cls 0
Palette $0,$FFF
Degree
Randomize Timer
Hide On
Led Off
Erase 1 : Erase 12 : Ptm Stop : Erase 33
Close Editor
Close Workbench
Assign "rpg:" To Dir$
Dim SCRVARNAME$(63),SCRPAUSE(255)
Dim PARSE$(9),PV(9),IV(9),DISPLAY$(3),DISPLAY_JUMP$(3)
Dim ITEMS$(255),ITEMHAVE(261),SCOMPILE$(99)
Dim RATINGS(6),CHAR_FRAMEBASE(63)
Dim CHAR_MOVEDIFF(63,1),CHAR_CANCOLLIDE(63)
Dim TCH(63),CHAR_ANIMFRAME(63)
Dim FRAME_DIDCHANGE(63)
Dim SCRIPT_CURRCOMMAND(63,3)
Dim FIGHT_ENEMIES(15),FIGHT_HP(15),FIGHT_POWER(15)
Dim FIGHT_RESPONSE(16),FIGHT_CHARGE(16),FIGHT_ATTACK(15)
Dim FIGHT_DEFENSE(15)
Dim ZNE_TYPE(255),MENU_VAR(9)
Dim EFFECT_SETTINGS(9),EFFECT_COLORS(9,9)
Dim NEWMENU$(9,1),NEWMENU_POS(9,1),MENU_COLORS(3)
Reserve As Work 45,64
Global SCRVARNAME$(),SCRPAUSE()
Global PARSE$(),PV(),IV(),DISPLAY$(),DISPLAY_JUMP$()
Global ITEMS$(),ITEMHAVE(),RATINGS(),CHAR_FRAMEBASE()
Global CHAR_MOVEDIFF(),CHAR_CANCOLLIDE(),SCOMPILE$()
Global TCH(),CHAR_ANIMFRAME(),FRAME_DIDCHANGE()
Global SCRIPT_CURRCOMMAND()
Global FIGHT_ENEMIES(),FIGHT_HP(),FIGHT_POWER(),FIGHT_RESPONSE()
Global FIGHT_CHARGE(),FIGHT_ATTACK(),FIGHT_DEFENSE()
Global ZNE_TYPE(),MENU_VAR()
Global EFFECT_SETTINGS(),EFFECT_COLORS()
Global NEWMENU$(),NEWMENU_POS(),MENU_COLORS()
Global SCR_START,SCR_END,SCR_EOF,SCR_PARSE,SCR_CURR
Global DAT_VARS,DAT_SCR,SCR_LEN,SCR_POS,SCR_MAX,SCR_BEGINHERE
Global TXT_GRAB,TXT_POS,DISP_OPTION,DISP_GO
Global DISP_ISOPEN,DISP_SWAP,ENEMY_MAX,IMDEAD
Global LEVEL_LOADNOW$,LEVEL_SKIPCHARXY,CHAR_NAME$,FRAMES_FILE$
Global FRAMES_LOAD$
Global WALK_DELAY,OFFSET_CHANGE,ZNE_CHECKED
Global CHAR_XPOS,CHAR_YPOS,NOFRONTFADE,BLACKSCREEN
Global MAP_WIDTH,MAP_HEIGHT,MAP_XPOS,MAP_YPOS
Global SSVTIMER,DISPLAY_SHOW,CURRMOD$,CURRLEVEL$
Global CONTROLLOCK,FRAME_PTR,VB_LINE,WALKTHRUWALLS
'Global _X1,_Y1,_X2,_Y2,_WHICH,PTR,A
VB_LINE=250
EFFECT_COLORS(0,0)=2
EFFECT_COLORS(0,1)=11
EFFECT_COLORS(0,2)=12
EFFECT_COLORS(1,0)=31
EFFECT_COLORS(1,1)=30
EFFECT_COLORS(1,2)=29
MUS_NOPLAY=(Instr(Upper$(CMND$),"NOMUSIC")>0)
CDROM=Exist("FE_FMV.iff")
ERR_FILE$="RPG:CTW_Error.abk"
On Error Proc INEXT_ERRORTRAP
Amos To Front
Amos Lock
'Test New Code Here
'Setup
NEWFRAME_SETUP
ITEM_PREP
GLOVAR_PREP
SCOMPILE_SETUP
'Intro Animation
Load "InextIntro.abk",255
S=Start(255)
S=Frame Play(S,1,7)
Double Buffer : Autoback 0
T=Timer+2
Repeat
Repeat : Until Timer>T
OS=S
S=Frame Play(S,1,7)
If S<>OS
Screen Swap : T=Timer+2
End If
Until S=OS
T=Timer+30 : Repeat : Until Timer>T
Fade 2 : T=Timer+30 : Repeat : Until Timer>T
Screen Close 7
Erase 255
If CDROM
FMV["FE_FMV.iff"]
End If
BACKTOINTRO:
Screen Open 0,320,200,2,Lowres : Cls 0
Palette $0,$FFF
CHAR_NAME$="Mike"
ZNEJUMP_LEAVE=-1
IMDEAD=False
RATING_SET["HP",50]
RATING_SET["MHP",50]
RATING_SET["STR",5]
RATING_SET["DEX",5]
RATING_SET["INT",5]
RATING_SET["CRED",50]
FULLINTRO
WHICH=Param
If WHICH=0
If Key State(20)
Clear Key
Print "Variable Space Free:";Free
Line Input "Name Of Level To Load:";LVL$
LEVEL_LOAD[LVL$]
Else
LEVEL_LOAD["level1.level"]
End If
Else If WHICH=1
Show On
FILE$=Fsel$("*.game","","Choose a Saved Game File")
Hide On
DIDLOAD=False
If FILE$<>"" : If Exist(FILE$)
DIDLOAD=True
GAME_LOAD[FILE$]
End If : End If
If DIDLOAD=False : Goto BACKTOINTRO : End If
Else If WHICH=2
If CDROM
FMV["FE_FMV.iff"]
Else
Load "CDROMOnly.spk",512
Unpack 512 To 6 : Screen Hide 6
Screen Open 7,320,200,4096,Lowres : Flash Off : Curs Off : Cls 0
Get Palette 6
For I=0 To 99
Screen Copy 6,0,I*2,320,(I*2)+1 To 7,0,I*2
Screen Copy 6,0,199-(I*2),320,200-(I*2) To 7,0,199-(I*2)
If(I and 3)=0 : Wait Vbl : End If
Next
Screen Close 6
T=Timer+200
Repeat : Until Timer>T or Fire(1)
Screen 7
For I=0 To 99
Cls 0,0,I*2 To 320,(I*2)+1
Cls 0,0,199-(I*2) To 320,200-(I*2)
If(I and 3)=0 : Wait Vbl : End If
Next
Screen Close 7
End If
Goto BACKTOINTRO
Else If WHICH=3
Erase 1 : Ptm Stop : Erase 33
Amos Unlock
Edit
End If
Do
If TXT_GRAB=-1
If Key State(68)
NEWMENU_ROUTINE
End If
If Key State(16)
Screen 2 : Fade 2
For I=63 To 0 Step -4
Ptm Volume I : Wait Vbl
Next
Wait 14 : Ptm Stop : Erase 33
CURRMOD$=""
Goto BACKTOINTRO
End If
SNAPSHOT
If Not CONTROLLOCK : If Not BLACKSCREEN
If Timer>WALK_DELAY
OXPOS=CHAR_XPOS : OYPOS=CHAR_YPOS
If Joy(1)>0
A=-1
If Jleft(1)
CHAR_XPOS=CHAR_XPOS-4
If CHAR_XPOS<0 : CHAR_XPOS=0 : End If
End If
If Jright(1)
CHAR_XPOS=CHAR_XPOS+4
If CHAR_XPOS>MAP_WIDTH : CHAR_XPOS=MAP_WIDTH : End If
End If
If CHAR_XPOS<>OXPOS
MAP_ZONECHECK[CHAR_XPOS,CHAR_YPOS] : A=Param
If A=0 : CHAR_XPOS=OXPOS : End If
If A=1 : WALK_DELAY=Timer+10 : End If
If A=2
MAP_ZONEGETVAR[ZNE_CHECKED,0] : B=Param
MAP_ZONEGETVAR[ZNE_CHECKED,1] : CHAR_XPOS=Param
MAP_ZONEGETVAR[ZNE_CHECKED,2] : CHAR_YPOS=Param
LEVEL_LOADNOW$="level"+(Str$(B)-" ")+".level"
LEVEL_SKIPCHARXY=((CHAR_XPOS>-1) and(CHAR_YPOS>-1))
End If
If A=3
MAP_ZONEGETVAR[ZNE_CHECKED,0] : GROUP=Param
FIGHT_SETUP[GROUP]
End If
If A=4
If ZNEJUMP_LEAVE=-1
MAP_ZONEGETVAR[ZNE_CHECKED,0] : CHAR=Param
MAP_ZONEGETVAR[ZNE_CHECKED,1] : LBL=Param
SCRIPT_JUMP[CHAR,"ZONELABEL"+(Str$(LBL)-" ")]
ZNEJUMP_LEAVE=ZNEJUMP_CHECKED
End If
End If
If ZNEJUMP_LEAVE<>ZNE_CHECKED : ZNEJUMP_LEAVE=-1 : End If
CHAR_COLLIDE[6]
If Param>-1
CHAR_YPOS=OYPOS : SCR=Param
If CHAR_CANCOLLIDE(SCR)
SCRIPT_JUMP[SCR,"COLLIDE"]
End If
End If
End If
If A=2 : Goto QUICKJUMP : End If
If Jup(1)
CHAR_YPOS=CHAR_YPOS-4
If CHAR_YPOS<0 : CHAR_YPOS=0 : End If
End If
If Jdown(1)
CHAR_YPOS=CHAR_YPOS+4
If CHAR_YPOS>MAP_HEIGHT : CHAR_YPOS=MAP_HEIGHT : End If
End If
If CHAR_YPOS<>OYPOS
MAP_ZONECHECK[CHAR_XPOS,CHAR_YPOS] : A=Param
If A=0 : CHAR_YPOS=OYPOS : End If
If A=1 : WALK_DELAY=Timer+10 : End If
If A=2
MAP_ZONEGETVAR[ZNE_CHECKED,0] : B=Param
MAP_ZONEGETVAR[ZNE_CHECKED,1] : CHAR_XPOS=Param
MAP_ZONEGETVAR[ZNE_CHECKED,2] : CHAR_YPOS=Param
LEVEL_LOADNOW$="level"+(Str$(B)-" ")+".level"
LEVEL_SKIPCHARXY=((CHAR_XPOS>-1) and(CHAR_YPOS>-1))
End If
If A=3
MAP_ZONEGETVAR[ZNE_CHECKED,0] : GROUP=Param
FIGHT_SETUP[GROUP]
End If
If A=4
If ZNEJUMP_LEAVE=-1
MAP_ZONEGETVAR[ZNE_CHECKED,0] : CHAR=Param
MAP_ZONEGETVAR[ZNE_CHECKED,1] : LBL=Param
SCRIPT_JUMP[CHAR,"ZONELABEL"+(Str$(LBL)-" ")]
ZNEJUMP_LEAVE=ZNE_CHECKED
End If
End If
If ZNEJUMP_LEAVE<>ZNE_CHECKED : ZNEJUMP_LEAVE=-1 : End If
CHAR_COLLIDE[6]
If Param>-1
CHAR_YPOS=OYPOS : SCR=Param
If CHAR_CANCOLLIDE(SCR)
SCRIPT_JUMP[SCR,"COLLIDE"]
End If
End If
End If
If Fire(1)
CHAR_COLLIDE[Deek(Sprite Base(I Bob(0) and $3FFF)+2)]
If Param>-1
W=Param
CHAR_FACE[0,W]
SCRIPT_JUMP[W,"TOUCH"]
End If
End If
QUICKJUMP:
CHAR_MOVEDIFF[0]
NEWFRAME_LOOP[0,False]
End If
End If : End If
End If
End If
SCRIPT_NEXTCMND
If IMDEAD
Screen 2 : Fade 2
CURRMOD$=""
For I=63 To 0 Step -4
Ptm Volume I : Wait Vbl
Next
Wait 14 : Ptm Stop : Erase 33
Goto BACKTOINTRO
End If
LEVEL_CHECK
If CONTROLLOCK
CHAR_XPOS=X Bob(0)
CHAR_YPOS=Y Bob(0)
SCRNSAVER_KILL
End If
Bob 0,CHAR_XPOS,CHAR_YPOS,
MAP_DISPLAY
SCRNSAVER
Loop
Procedure CHAR_MOVEDIFF[WHICH]
On Error Proc INEXT_ERRORTRAP
DX=X Bob(WHICH)-CHAR_MOVEDIFF(WHICH,0)
DY=Y Bob(WHICH)-CHAR_MOVEDIFF(WHICH,1)
If DX<>0 or DY<>0
NEWFRAME_CURRFRAMESET[WHICH] : CF=Param
If Abs(DX)>Abs(DY)
If DX>0 : NF=2
Else : NF=3 : End If
Else
If DY>0 : NF=0
Else : NF=1 : End If
End If
NF=NF+CHAR_FRAMEBASE(WHICH)
If NF<>CF
NEWFRAME_SET[WHICH,NF,False]
End If
CHAR_MOVEDIFF(WHICH,0)=X Bob(WHICH)
CHAR_MOVEDIFF(WHICH,1)=Y Bob(WHICH)
End If
End Proc
Procedure SCRIPT_PREP
On Error Proc INEXT_ERRORTRAP
SCR_MAX=-1 : TXT_GRAB=-1 : SCR_CURR=0
Erase 69 : Erase 70
Reserve As Work 68,65536 : Rem Variables
Reserve As Work 67,5120 : Rem Scripts and Groups
DAT_VARS=Start(68) : DAT_SCR=Start(67)
End Proc
Procedure SCRIPT_SKIP
On Error Proc INEXT_ERRORTRAP
Loke DAT_SCR+(SCR_CURR*12),0
Loke DAT_SCR+(SCR_CURR*12)+4,0
Inc SCR_CURR : Inc SCR_MAX
End Proc
Procedure SCRIPT_LOAD[FILE$]
On Error Proc INEXT_ERRORTRAP
If Not Exist(FILE$)
INEXT_ERROR["Cannot Find .script File","",FILE$]
End If
Open In 1,FILE$
Reserve As Work 69,Lof(1)
Sload 1 To 69,Lof(1)
Close 1
SCR_START=Start(69) : SCR_END=Start(69)+Length(69)-1
Lfilter 0,31,32,Start(69) To SCR_END
Reserve As Work 71,Length(69)
PTR=Start(69) : CURRVAR=0 : MPTR=Start(71)
CHAR_CANCOLLIDE(SCR_CURR)=False
SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1
SCRPAUSE(SCR_CURR)=0
CHAR_ANIMFRAME(SCR_CURR)=False
Repeat
SCRIPT_GETCMND[PTR] : PTR=Param
If Not SCR_EOF
SP$=""
For I=0 To SCR_PARSE
If Asc(PARSE$(I))=64
A=-1
For J=0 To CURRVAR
If SCRVARNAME$(J)=PARSE$(I)
A=J : J=255
End If
Next
If A>-1
PARSE$(I)=Str$(A)-" "
Else
SCRVARNAME$(CURRVAR)=PARSE$(I)
PARSE$(I)=Str$(CURRVAR)-" "
Inc CURRVAR
End If
PARSE$(I)="@"+PARSE$(I)
End If
If I=0
For J=0 To 99
If SCOMPILE$(J)=PARSE$(0)
PARSE$(0)=Chr$(J+69) : J=99
End If
Next
End If
If I=SCR_PARSE
PARSE$(I)=PARSE$(I)+"|"
Else
PARSE$(I)=PARSE$(I)+" "
End If
SP$=SP$+PARSE$(I)
Next
Lbstr SP$,MPTR
MPTR=MPTR+Len(SP$)
If Upper$(PARSE$(0))=":COLLIDE|"
CHAR_CANCOLLIDE(SCR_CURR)=True
End If
End If
Until SCR_EOF
For I=0 To CURRVAR
SCRVARNAME$(I)=""
Next
TCH(SCR_CURR)=False
SCR_EOF=False
Bank Shrink 71 To MPTR-Start(71)
SCR_LEN=Length(71)
If Length(70)=0
Reserve As Work 70,Length(71)
Copy Start(71),Start(71)+Length(71) To Start(70)
SCR_POS=0
Else
SCR_POS=Length(70)
Reserve As Work 72,Length(70)+Length(71)
Copy Start(70),Start(70)+Length(70) To Start(72)
Copy Start(71),Start(71)+Length(71) To Start(72)+Length(70)
Bank Swap 72,70 : Erase 72
End If
SCR_BEGINHERE=Start(70)
D=SCR_CURR*12
Loke DAT_SCR+D,SCR_POS
Loke DAT_SCR+D+4,SCR_LEN
Loke DAT_SCR+D+8,0
Erase 71 : Inc SCR_CURR : Inc SCR_MAX
End Proc
Procedure SCOMPILE_SETUP
On Error Proc INEXT_ERRORTRAP
Open In 1,"CompileList.txt"
Set Input 10,-1
Repeat
Line Input #1,A$
If Lwords(A$)=2
SCOMPILE$(Val(Lword(1,A$)))=Upper$(Lword(2,A$))
End If
Until Eof(1)
Close 1
End Proc
Procedure SNAPSHOT
If Key State(89)
S=Screen : Screen 2
A$=Fsel$("*.iff","","Enter a name for the Snapshot")
If A$<>"" : Save Iff A$ : End If
Screen S
End If
End Proc
Procedure SCRIPT_GROUP[V,S]
On Error Proc INEXT_ERRORTRAP
Loke DAT_SCR+3072+(SCR_CURR*4),V
Loke DAT_SCR+4096+(SCR_CURR*4),S
End Proc
Procedure SCRIPT_GETGROUP[NUM]
On Error Proc INEXT_ERRORTRAP
ENEMY_MAX=-1
For I=1 To SCR_MAX
If Leek(DAT_SCR+3072+I*4)=NUM
If X Bob(I)>-50 and Y Bob(I)>-50
Inc ENEMY_MAX
FIGHT_ENEMIES(ENEMY_MAX)=I
FIGHT_POWER(ENEMY_MAX)=Leek(DAT_SCR+4096+I*4)
End If
End If
Next
End Proc
Procedure SCRIPT_SCRGROUP[WHICH]
On Error Proc INEXT_ERRORTRAP
End Proc[Leek(DAT_SCR+3072+WHICH*4)]
Procedure CHAR_SET[FILE$,X,Y,F,V,S]
'On Error Proc INEXT_ERRORTRAP
SCRIPT_GROUP[V,S]
NEWFRAME_SET[SCR_CURR,F,False]
For I=0 To 3
NEWFRAME_GRABSET[F+I]
Next
CHAR_FRAMEBASE(SCR_CURR)=F
Bob SCR_CURR,X,Y,
CHAR_MOVEDIFF(SCR_CURR,0)=X
CHAR_MOVEDIFF(SCR_CURR,1)=Y
SCRIPT_LOAD[FILE$]
End Proc
Procedure SCRIPT_NEXTCMND
'On Error Proc INEXT_ERRORTRAP
Shared MUS_NOPLAY
If DISP_ISOPEN and DISP_GO
DISPLAY_WAIT
Else
Comp Test Off
For SCR_CURR=0 To SCR_MAX
If X Bob(SCR_CURR)>-50 and Y Bob(SCR_CURR)>-50
If Timer>SCRPAUSE(SCR_CURR)
If CHAR_ANIMFRAME(SCR_CURR)
NEWFRAME_MOVE[SCR_CURR,False]
CHAR_ANIMFRAME(SCR_CURR)= Not Param
If Not CHAR_ANIMFRAME(SCR_CURR)
NEWFRAME_CHANGE[SCR_CURR]
If Not Param
CHAR_MOVEDIFF[SCR_CURR]
End If
End If
Else
If SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1
SC=SCR_CURR*12
SCR_START=SCR_BEGINHERE+Leek(DAT_SCR+SC)
SCR_END=SCR_START+Leek(DAT_SCR+SC+4)
If SCR_START<>SCR_END
PTR=SCR_START+Leek(DAT_SCR+SC+8)
OPTR=PTR
A=Hunt(PTR To SCR_END,"|")
If A=0
SCR_EOF=True
Goto __STOPSCR
Else
SCR_EOF=False
A$=Lstr(PTR,A-PTR) : A=A+1
SCR_PARSE=Lwords(A$)
For I=1 To SCR_PARSE
PARSE$(I-1)=Lword(I,A$)
Next
SCR_PARSE=SCR_PARSE-1
End If
__STOPSCR:
If Not SCR_EOF
PTR=A
C=-1
If Len(PARSE$(0))=1
C=Asc(PARSE$(0))-69
End If
SCRIPT_CURRCOMMAND(SCR_CURR,0)=C
SCRIPT_CURRCOMMAND(SCR_CURR,1)=-1
FRAME_DIDCHANGE(SCR_CURR)=False
If SCR_PARSE>0
XYZ=SCR_CURR*256
For I=1 To SCR_PARSE
If Asc(PARSE$(I))=64
IV(I)=Val(Mid$(PARSE$(I),2))
PV(I)=Leek(DAT_VARS+XYZ+IV(I)*4)
Else
PV(I)=Val(PARSE$(I))
IV(I)=-1
End If
Next
End If
If TXT_GRAB=SCR_CURR
If(C<>50 and C<>51)
If TXT_POS>0
DISP_GO=True
DISPLAY_FIGOPTIONS
DISPLAY_TEXT
Repeat
DISPLAY_WAIT
Until Not DISP_GO
End If
DISPLAY_CLOSE
TXT_GRAB=-1 : TXT_POS=0
End If
End If
End If
End If
Else
C=SCRIPT_CURRCOMMAND(SCR_CURR,0)
End If
OXBOB=X Bob(SCR_CURR)
OYBOB=Y Bob(SCR_CURR)
Gosub CMNDSET1
If TXT_GRAB=SCR_CURR
If TXT_POS=4
DISP_GO=True
DISPLAY_FIGOPTIONS
DISPLAY_TEXT
Repeat
DISPLAY_WAIT
Until Not DISP_GO
TXT_POS=0
End If
End If
NEWFRAME_CHANGE[SCR_CURR]
TA= Not Param
TB= Not WALKTHRUWALLS
If TA and TB
X=X Bob(SCR_CURR) : Y=Y Bob(SCR_CURR)
MAP_ZONECHECK[X,Y] : A=Param
If A=0 : X=OXBOB : End If
MAP_ZONECHECK[X,Y] : A=Param
If A=0 : Y=OYBOB : End If
Bob SCR_CURR,X,Y,
End If
If Not NOSETPOINTER
If OPTR=SCR_START+Leek(DAT_SCR+SC+8)
Loke DAT_SCR+SC+8,PTR-SCR_START
NOSETPOINTER=False
End If
End If
End If
End If
NEWFRAME_CHANGE[SCR_CURR] : DC=Param
If DC and Not FRAME_DIDCHANGE(SCR_CURR)
NEWFRAME_LOOP[SCR_CURR,False]
End If
End If
Next
SUPERSKIP:
Comp Test On
End If
Pop Proc
CMNDSET1:
'If C$="SET"
If C=52 : Return : End If
If C=0
VAR_SET[IV(1),PV(2)]
'Else If C$="MATH"
Else If C=1
O$=PARSE$(2)
If O$="+"
RES=PV(1)+PV(3)
Else If O$="-"
RES=PV(1)-PV(3)
Else If O$="*"
RES=PV(1)*PV(3)
Else If O$="/" and PV(3)<>0
RES=PV(1)/PV(3)
Else If O$="%" and PV(3)<>0
RES=PV(1) mod PV(3)
Else If O$="="
RES=(PV(1)=PV(3))
Else If O$="<"
RES=(PV(1)<PV(3))
Else If O$=">"
RES=(PV(1)>PV(3))
Else If O$="<=" or O$="=<"
RES=(PV(1)<=PV(3))
Else If O$="=>" or O$=">="
RES=(PV(1)=>PV(3))
Else If O$="<>"
RES=(PV(1)<>PV(3))
End If
If SCR_PARSE=4
VAR_SET[IV(4),RES]
Else
VAR_SET[IV(1),RES]
End If
'Else If C$="PAUSE"
Else If C=2
SCRPAUSE(SCR_CURR)=Timer+PV(1)*50
Else If C=3
'Else If C$="FACE"
A=Instr("SNEW",Upper$(PARSE$(1)))
If A=0
CHAR_MOVEDIFF(SCR_CURR,0)=X Bob(SCR_CURR)+(X Bob(SCR_CURR)-X Bob(PV(1)))
CHAR_MOVEDIFF(SCR_CURR,1)=Y Bob(SCR_CURR)+(Y Bob(SCR_CURR)-Y Bob(PV(1)))
CHAR_MOVEDIFF[SCR_CURR]
Else
CF=CHAR_FRAMEBASE(SCR_CURR)+A-1
NEWFRAME_SET[SCR_CURR,CF,False]
End If
'Else If C$="FRAMEANIM"
Else If C=4
CHAR_ANIMFRAME(SCR_CURR)=True
NEWFRAME_SET[SCR_CURR,PV(1),False]
NEWFRAME_RESET
NEWFRAME_GRABSET[PV(1)]
NEWFRAME_FULLREQUEST
'Else If C$="MENURESET"
Else If C=5
NEWMENU_RESET
'Else If C$="MENUADD"
Else If C=6
NEWMENU_ADD[PARSE$(1)-Chr$(34),PARSE$(2)-Chr$(34)]
'Else If C$="MENUCHOICE"
Else If C=7
NEWMENU_CHOICE
A=Param : VAR_SET[IV(1),A]
'Else If C$="MOVE"
Else If C=8
X=X Bob(SCR_CURR)+PV(1) : Y=Y Bob(SCR_CURR)+PV(2)
Bob SCR_CURR,X,Y,
NEWFRAME_LOOP[SCR_CURR,False]
CHAR_MOVEDIFF[SCR_CURR]
End If
'If C$="GOTO"
If C=9
LABEL$=":"+PARSE$(1)
A=Hunt(SCR_START To SCR_END,LABEL$)
If A>0 : PTR=A+Len(LABEL$)+1 : End If
'Else If C$="ONGOTO"
Else If C=10
JMP=(PV(2)-PV(1))+3
If JMP=<SCR_PARSE
LABEL$=":"+PARSE$(JMP)
A=Hunt(SCR_START To SCR_END,LABEL$)
If A>0 : PTR=A+Len(LABEL$)+1 : End If
End If
'Else If C$="LABELJUMP"
Else If C=11
SCRIPT_JUMP[PV(1),PARSE$(2)]
NOSETPOINTER=(SCR_CURR=PV(1))
'Else If C$="TOGGLETOUCH"
Else If C=12
TCH(SCR_CURR)= Not TCH(SCR_CURR)
'Else If C$="WALK"
Else If C=13
If SCRIPT_CURRCOMMAND(SCR_CURR,1)=-1
SCRIPT_CURRCOMMAND(SCR_CURR,1)=PV(1)
SCRIPT_CURRCOMMAND(SCR_CURR,2)=PV(2)
SCRIPT_CURRCOMMAND(SCR_CURR,3)=PV(3)
End If
D=SCRIPT_CURRCOMMAND(SCR_CURR,1)
S=SCRIPT_CURRCOMMAND(SCR_CURR,2)
T=SCRIPT_CURRCOMMAND(SCR_CURR,3)
X=X Bob(SCR_CURR) : Y=Y Bob(SCR_CURR)
If D=0
Y=Y-S
Else If D=1
Y=Y+S
Else If D=2
X=X-S
Else If D=3
X=X+S
End If
Bob SCR_CURR,X,Y,
NEWFRAME_LOOP[SCR_CURR,False]
CHAR_MOVEDIFF[SCR_CURR]
T=T-1
If T=0 : SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1 : End If
SCRIPT_CURRCOMMAND(SCR_CURR,3)=T
'Else If C$="KEYDOWN"
Else If C=14
A$=Upper$(Inkey$)
VAR_SET[IV(2),Upper$(PARSE$(1))=A$]
'Else If C$="TOGGLEDISPLAY"
Else If C=15
DISPLAY_SHOW= Not DISPLAY_SHOW
'Else If C$="WALKTO"
Else If C=16
If SCRIPT_CURRCOMMAND(SCR_CURR,1)=-1
SCRIPT_CURRCOMMAND(SCR_CURR,1)=PV(1)
SCRIPT_CURRCOMMAND(SCR_CURR,2)=PV(2)
SCRIPT_CURRCOMMAND(SCR_CURR,3)=PV(3)
End If
X=X Bob(SCR_CURR) : Y=Y Bob(SCR_CURR)
DX=SCRIPT_CURRCOMMAND(SCR_CURR,1)
DY=SCRIPT_CURRCOMMAND(SCR_CURR,2)
SPEED=SCRIPT_CURRCOMMAND(SCR_CURR,3)
FX=DX-X : FY=DY-Y
GD=Max(Abs(FX),Abs(FY))
'GD=(Abs(FX)+Abs(FY))/2
If SPEED>GD
X=DX : Y=DY
SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1
Else
X=X+(FX*SPEED)/GD
Y=Y+(FY*SPEED)/GD
MAP_ZONECHECK[X,OYBOB]
If Param=0 : X=OXBOB : Y=OYBOB+(FY*SPEED)/FY : End If
MAP_ZONECHECK[OXBOB,Y]
If Param=0 : Y=OYBOB : X=OXBOB+(FX*SPEED)/FX : End If
End If
Bob SCR_CURR,X,Y,
NEWFRAME_LOOP[SCR_CURR,False]
CHAR_MOVEDIFF[SCR_CURR]
'VAR_SET[IV(4),(X=DX) and(Y=DY)]
'Else If C$="CHANGEFRAMEBASE"
Else If C=17
CHAR_FRAMEBASE(SCR_CURR)=PV(1)
'Else If C$="MOVETO"
Else If C=18
Bob SCR_CURR,PV(1),PV(2),
CHAR_MOVEDIFF(SCR_CURR,0)=X Bob(SCR_CURR)
CHAR_MOVEDIFF(SCR_CURR,1)=Y Bob(SCR_CURR)
'Else If C$="IF"
Else If C=19
If SCR_PARSE=2
RES=(PV(1)=True) : P=2
Else
O$=PARSE$(2) : P=4
If O$="="
RES=(PV(1)=PV(3))
Else If O$="<"
RES=(PV(1)<PV(3))
Else If O$=">"
RES=(PV(1)>PV(3))
Else If O$="<=" or O$="=<"
RES=(PV(1)<=PV(3))
Else If O$="=>" or O$=">="
RES=(PV(1)=>PV(3))
Else If O$="<>"
RES=(PV(1)<>PV(3))
End If
End If
If RES
LABEL$=":"+PARSE$(P)
A=Hunt(SCR_START To SCR_END,LABEL$)
If A>0 : PTR=A+Len(LABEL$)+1 : End If
End If
'Else If C$="WAIT"
Else If C=20
SCRPAUSE(SCR_CURR)=Timer+PV(1)
'Else If C$="RND"
Else If C=21
VAR_SET[IV(1),Rnd(PV(2))]
'Else If C$="TIMER"
Else If C=22
VAR_SET[IV(1),Timer]
'Else If C$="GLOSET"
Else If C=23
GLOVAR_SET[PV(1),PV(2)]
'Else If C$="GLOGET"
Else If C=24
GLOVAR_GET[PV(1)] : A=Param : VAR_SET[IV(2),A]
'Else If C$="BITSET"
Else If C=25
Bset PV(2),PV(1)
VAR_SET[IV(1),PV(1)]
'Else If C$="BITCLR"
Else If C=26
Bclr PV(2),PV(1)
VAR_SET[IV(1),PV(1)]
'Else If C$="BITCHG"
Else If C=27
Bchg PV(2),PV(1)
VAR_SET[IV(1),PV(1)]
'Else If C$="BITGET"
Else If C=28
VAR_SET[IV(3),Btst(PV(2),PV(1))]
End If
'If C$="ADDITEM"
If C=29
ITEM_ADD[PARSE$(1)-Chr$(34)]
'Else If C$="HAVEITEM"
Else If C=30
ITEM_HAVE[PARSE$(1)-Chr$(34)] : A=Param
VAR_SET[IV(2),A]
'Else If C$="TAKEITEM"
Else If C=31
ITEM_REMV[PARSE$(1)-Chr$(34)] : A=Param
VAR_SET[IV(2),A]
'Else If C$="ITEMSPEC"
Else If C=32
ITEM_STATS[PARSE$(1)-Chr$(34),PARSE$(2)-Chr$(34)] : A=Param
VAR_SET[IV(3),A]
'Else If C$="KILL"
Else If C=33
Bob SCR_CURR,-50,-50,
'Else If C$="LOADLEVEL"
Else If C=34
LEVEL_LOADNOW$=PARSE$(1)
If SCR_PARSE=3
CONTROLLOCK=True
CHAR_XPOS=PV(2)
CHAR_YPOS=PV(3)
LEVEL_SKIPCHARXY=((PV(2)>-1) and(PV(3)>-1))
End If
SCR_CURR=SCR_MAX
Pop
Goto SUPERSKIP
'Else If C$="ITEMREMOVE"
Else If C=35
A=Start(58)+768
Bset A+(PV(1) mod 8),A+(PV(1)/8)
'Else If C$="ITEMISGONE"
Else If C=36
A=Start(58)+768
VAR_SET[IV(2),Btst(A+(PV(1) mod 8),A+(PV(1)/8))]
'Else If C$="ITEMKILL"
Else If C=37
A=Start(58)+768
If Btst(A+(PV(1) mod 8),A+(PV(1)/8))
Bob SCR_CURR,-50,-50,
End If
'Else If C$="ITEMPUTBACK"
Else If C=38
A=Start(58)+768
Bclr A+(PV(1) mod 8),A+(PV(1)/8)
'Else If C$="ATTACK"
Else If C=39
Repeat
DISPLAY_WAIT
Until Not DISP_GO
DISPLAY_CLOSE
If SCR_PARSE=1
FIGHT_SETUP[PV(1)]
Else
SCRIPT_SCRGROUP[SCR_CURR] : WG=Param
FIGHT_SETUP[WG]
End If
'Else If C$="SOUND"
Else If C=40
PARSE$(1)=PARSE$(1)-Chr$(34)
SOUND_PLAY[PARSE$(1),Val(PARSE$(3)),Val(PARSE$(2)),269]
'Else If C$="BUY"
Else If C=41
PARSE$(1)=PARSE$(1)-Chr$(34)
ITEM_WHICH[PARSE$(1)]
If Param>0
ITEM_STATS[PARSE$(1),"COST"] : CST=Param
RATING_GET["CRED"] : CASH=Param
If CASH=>CST
CASH=CASH-CST
ITEM_ADD[PARSE$(1)]
RATING_SET["CRED",CASH]
PV(2)=-1
Else
PV(2)=0
End If
Else
PV(2)=0
End If
VAR_SET[IV(2),PV(2)]
'Else If C$="SELL"
Else If C=42
PARSE$(1)=PARSE$(1)-Chr$(34)
ITEM_HAVE[PARSE$(1)]
If Param
ITEM_STATS[PARSE$(1),"COST"] : SELL=(Param*3)/4
RATING_GET["CRED"] : CASH=Param+SELL
RATING_SET["CRED",CASH]
ITEM_REMV[PARSE$(1)]
VAR_SET[IV(2),True]
Else
VAR_SET[IV(2),False]
End If
'Else If C$="COORDS"
Else If C=43
'_IBOB_CHECK[PV(1)]
'Trap A=I Bob(PV(1))
'If A>0
X=X Bob(PV(1))
Y=Y Bob(PV(1))
VAR_SET[IV(2),X]
VAR_SET[IV(3),Y]
'End If
'Else If C$="RATINGGET"
Else If C=44
RATING_GET[PARSE$(1)] : A=Param
VAR_SET[IV(2),A]
'Else If C$="RATINGSET"
Else If C=45
RATING_SET[PARSE$(1),PV(2)]
'Else If C$="FADEOUT"
Else If C=46
CS=Screen : Screen 2
Fade PV(1) : Screen CS
Wait PV(1)*15
BLACKSCREEN=True
'Else If C$="FADEIN"
Else If C=47
CS=Screen : Screen 2
Fade PV(1) To 0 : Screen CS
Wait PV(1)*15
BLACKSCREEN=False
'Else If C$="LOCKCONTROLS"
Else If C=48
CONTROLLOCK=True
WALKTHRUWALLS=(PV(1)=1)
'Else If C$="UNLOCKCONTROLS"
Else If C=49
CONTROLLOCK=False
WALKTHRUWALLS=False
'Else If C$="[" or C$="]"
Else If C=50 or C=51
If C=51
M$="!"+(PARSE$(1)-Chr$(34))
J$=PARSE$(2)
Else
M$=PARSE$(1)-Chr$(34) : J$=""
If SCR_PARSE=0
If TXT_POS>0
DISP_GO=True
DISPLAY_FIGOPTIONS
DISPLAY_TEXT
Repeat
DISPLAY_WAIT
Until Not DISP_GO
End If
TXT_POS=0
Else
If SCR_PARSE>1
For I=2 To SCR_PARSE
TXT_REPLACE[M$,"%"+(Str$(I-1)-" "),Str$(PV(I))-" "]
M$=Param$
Next
End If
TXT_REPLACE[M$,"%n",CHAR_NAME$] : M$=Param$
End If
End If
If TXT_GRAB=-1
If SCR_PARSE>0
TXT_GRAB=SCR_CURR : TXT_POS=0
DISPLAY$(TXT_POS)=M$ : DISP_GO=False
DISPLAY_JUMP$(TXT_POS)=J$
ISGRAB=True
Inc TXT_POS
End If
Else If TXT_GRAB=SCR_CURR
If SCR_PARSE>0
DISPLAY$(TXT_POS)=M$
DISPLAY_JUMP$(TXT_POS)=J$
ISGRAB=True
Inc TXT_POS
End If
End If
Else If C=53
'PlayMod
A$="mods/"+PARSE$(1)
If Exist(A$)=True
NEWMOD$=Upper$(A$)
End If
If Not MUS_NOPLAY
If NEWMOD$<>CURRMOD$
For I=63 To 0 Step -4
Ptm Volume I : Wait Vbl
Next
Ptm Stop : Erase 33
If NEWMOD$<>""
If Not Exist("RPG:"+NEWMOD$)
INEXT_ERROR["Unable to find MOD File",NEWMOD$,"In Mods Directory"]
End If
Ptm Load "RPG:"+NEWMOD$,33 : Ptm Volume 63
Ptm Play 33
End If
CURRMOD$=NEWMOD$
End If
End If
'CHANGENAME
Else If C=54
CHAR_NAME$=PARSE$(1)
'QUAKE AMIGA
Else If C=56
T=Timer+PV(1)*60
Repeat
X=Rnd(4)-2
Y=Rnd(4)-2
Screen Display 2,128+X,50+Y,,
Wait Vbl
Until Timer>T
Screen Display 2,128,50,,
Else If C=57
CS=Screen : Screen 2
Fade 2 : Screen CS
Wait 30
CREDITS[PV(1)]
IMDEAD=True
End If
If(C<>16) and(C<>52) and(C<>13) : SCRIPT_CURRCOMMAND(SCR_CURR,0)=-1 : End If
Return
End Proc
Procedure SCRIPT_GETCMND[PTR]
On Error Proc INEXT_ERRORTRAP
A=Hunt(PTR To SCR_END,"|")
If A=0
SCR_EOF=True
Goto __STOPSCR
Else
SCR_EOF=False
A$=Lstr(PTR,A-PTR) : A=A+1
SCR_PARSE=Lwords(A$)-1
For I=0 To SCR_PARSE
PARSE$(I)=Lword(I+1,A$)
Next
End If
__STOPSCR:
End Proc[A]
Procedure SCRIPT_JUMP[SCRIPT,LABEL$]
On Error Proc INEXT_ERRORTRAP
HSCR_START=Start(70)+Leek(DAT_SCR+(SCRIPT*12))
HSCR_END=HSCR_START+Leek(DAT_SCR+(SCRIPT*12)+4)
If HSCR_START<>HSCR_END
If Not TCH(SCRIPT)
LABEL$=":"+LABEL$
A=Hunt(HSCR_START To HSCR_END,LABEL$)
If A>0
Loke DAT_SCR+(SCRIPT*12)+8,(A+Len(LABEL$)+1)-HSCR_START
SCRIPT_CURRCOMMAND(SCRIPT,0)=-1
End If
End If
End If
End Proc
Procedure VAR_SET[N,V]
On Error Proc INEXT_ERRORTRAP
If N>-1
Loke DAT_VARS+SCR_CURR*256+N*4,V
End If
End Proc
Procedure VAR_GET[N]
On Error Proc INEXT_ERRORTRAP
End Proc[Leek(Start(68)+SCR_CURR*256+N*4)]
Procedure GLOVAR_PREP
On Error Proc INEXT_ERRORTRAP
Reserve As Work 58,1024
End Proc
Procedure GLOVAR_SET[N,V]
On Error Proc INEXT_ERRORTRAP
Loke Start(58)+N*4,V
End Proc
Procedure GLOVAR_GET[N]
On Error Proc INEXT_ERRORTRAP
End Proc[Leek(Start(58)+N*4)]
Procedure MAP_FRONTSCREEN
On Error Proc INEXT_ERRORTRAP
Shared FRONT_ISOPEN
If Not FRONT_ISOPEN
Screen Open 2,320,200,64,Lowres : Flash Off : Curs Off : Cls 0
Double Buffer : Autoback 0 : Gr Writing 0
For I=0 To 31 : Colour I,0 : Next
FRONT_ISOPEN=True
Screen 0
End If
End Proc
Procedure MAP_FRONTFADEIN
On Error Proc INEXT_ERRORTRAP
Shared FRONT_ISOPEN
If FRONT_ISOPEN
BLACKSCREEN=False
S=Screen
MAP_DISPLAY
Screen 2
Fade 3 To 0 : Wait 45
FONT_FIND["XEN.font/8"]
Set Font Param
Screen S
End If
End Proc
Procedure MAP_SCREENLOAD[FILE$]
On Error Proc INEXT_ERRORTRAP
XPK_BANKUNPACK[FILE$,14]
Unpack 14 To 0 : Screen Hide 0
Erase 14
Priority On
Priority Reverse Off
Bob Update Off
MAP_ZONERESET
SW=Screen Width-1 : SH=Screen Height-1 : SC=Screen Colour
MAP_FRONTCLOSE
MAP_FRONTSCREEN
DX=CHAR_XPOS-160 : DY=CHAR_YPOS-100
If DX>SW-320 : DX=SW-320 : End If
If DX<0 : DX=0 : End If
If DY>SH-200 : DY=SH-200 : End If
If DY<0 : DY=0 : End If
MAP_WIDTH=SW : MAP_HEIGHT=SH
MAP_XPOS=DX : MAP_YPOS=DY
Screen 0
End Proc
Procedure MAP_DISPLAY
'On Error Proc INEXT_ERRORTRAP
SC=Screen
Bob Clear : Bob Draw
MAP_XPOS=CHAR_XPOS-160
MAP_YPOS=CHAR_YPOS-100
If MAP_XPOS+320>MAP_WIDTH : MAP_XPOS=MAP_WIDTH-320 : End If
If MAP_XPOS<0 : MAP_XPOS=0 : End If
If MAP_YPOS+200>MAP_HEIGHT : MAP_YPOS=MAP_HEIGHT-200 : End If
If MAP_YPOS<0 : MAP_YPOS=0 : End If
If DISPLAY_SHOW
Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0
EFFECT_LAYDOWN
Screen Swap : Wait Vbl
End If
Screen SC
End Proc
Procedure MAP_OFFSETFIX[X,Y]
On Error Proc INEXT_ERRORTRAP
MAP_XPOS=X-160
MAP_YPOS=Y-100
If MAP_XPOS+320>MAP_WIDTH : MAP_XPOS=MAP_WIDTH-320 : End If
If MAP_XPOS<0 : MAP_XPOS=0 : End If
If MAP_YPOS+200>MAP_HEIGHT : MAP_YPOS=MAP_HEIGHT-200 : End If
If MAP_YPOS<0 : MAP_YPOS=0 : End If
End Proc
Procedure MAP_FRONTCLOSE
On Error Proc INEXT_ERRORTRAP
Shared FRONT_ISOPEN
If FRONT_ISOPEN
BLACKSCREEN=True
Screen 2 : Fade 3 : Wait 45
Screen Close 2
FRONT_ISOPEN=False
Screen 0
End If
End Proc
Procedure EFFECT_SETUP
On Error Proc INEXT_ERRORTRAP
If EFFECT_SETTINGS(0)>0
KB=True
CF=EFFECT_SETTINGS(0)
S=Screen
Screen Open 5,320,200,32,Lowres : Curs Off : Cls 0
Screen Hide 5
If CF=1
Screen 0
For I=0 To 31
E=0 : Z=1 : A=Colour(I)
For J=0 To 2
E=E+Max((((A/Z) and 15)-2)*Z,0) : Z=Z*16
Next
Colour I,E
Next
Screen 5
For I=1 To EFFECT_SETTINGS(1)
X=Rnd(320) : Y=Rnd(200)
Ink EFFECT_COLORS(0,2) : Draw X,Y To X,Y+3
Ink EFFECT_COLORS(0,1) : Plot X,Y+4
Ink EFFECT_COLORS(0,0) : Plot X,Y+5
Next
EFFECT_SETTINGS(9)=0
Else If CF=2
Screen 0
For I=0 To 31
E=0 : Z=1 : A=Colour(I)
For J=0 To 2
E=E+Min((((A/Z) and 15)+1),15)*Z : Z=Z*16
Next
Colour I,E
Next
Screen 5
For I=1 To EFFECT_SETTINGS(1)
X=Rnd(320) : Y=Rnd(200)
Ink EFFECT_COLORS(1,0) : Box X,Y To X+1,Y+1
Ink EFFECT_COLORS(1,1) : Plot X,Y+1
Ink EFFECT_COLORS(1,2) : Plot X+1,Y
Next
EFFECT_SETTINGS(9)=0
Else If CF=3
KB=False
CS=Start(45)
EFFECT_SETTINGS(9)=0
Screen 0
For I=0 To 31
E=0 : Z=1 : A=Colour(I)
For J=0 To 2
E=E+Max((((A/Z) and 15)-4),0)*Z : Z=Z*16
Next
Doke CS,E : CS=CS+2
Next
Else If CF=4
KB=False
CS=Start(45)
EFFECT_SETTINGS(9)=0
Screen 0
For I=0 To 31
E=0 : F=0 : Z=1 : A=Colour(I)
For J=0 To 2
F=F+Max((((A/Z) and 15)-2),0)*Z
E=E+Min((((A/Z) and 15)+4),15)*Z : Z=Z*16
Next
Doke CS,E : CS=CS+2 : Colour I,F
Next
Else If CF=5
Screen 0
SC=Screen Colour-1
MX=200 : MZ=-1
For I=1 To SC
A=Colour(I) : Z=1 : E=0
For J=0 To 2
E=E+((A/Z) and 15)
Z=Z*16
Next
If E<MX : MX=E : MZ=I : End If
Next
Screen 5
Ink MZ
Gr Writing 0
For I=8 To 0 Step -1
XD=(I*120)/8+40
YD=(I*60)/8+40
If I=0
P=1
Else If I=8
P=0
Else
P=I+27
End If
Set Pattern P
Cls 0,160-XD,100-YD To 160+XD,100+YD
Ink MZ,0 : Bar 160-XD,100-YD To 160+XD,100+YD
Next
Else If CF=99
XPK_BANKUNPACK["RPG:Maps/effect"+(Str$(EFFECT_SETTINGS(1))-" ")+".spk",29]
Unpack 29 To 5
Erase 29
End If
If KB
Get Block 200,0,0,320,200,1
End If
Screen Close 5
Screen S
End If
End Proc
Procedure EFFECT_LAYDOWN
'On Error Proc INEXT_ERRORTRAP
ST=Screen
If EFFECT_SETTINGS(0)>0
If EFFECT_SETTINGS(0)=1 or EFFECT_SETTINGS(0)=2
Screen 2
Put Block 200,0,EFFECT_SETTINGS(9)
Put Block 200,0,EFFECT_SETTINGS(9)-200
Screen 0
EFFECT_SETTINGS(9)=(EFFECT_SETTINGS(9)+EFFECT_SETTINGS(2)) mod 200
Else If EFFECT_SETTINGS(0)=5
Screen 2
Put Block 200,0,0
Screen 0
Else If EFFECT_SETTINGS(0)=99
Screen 2
Put Block 200,0,0
Screen 0
Else If EFFECT_SETTINGS(0)=3
If Rnd(1)=0
Screen 2
If EFFECT_SETTINGS(9)
Get Palette 0
Else
S=Start(45)
For I=0 To 31
Colour I,Deek(S) : S=S+2
Next
End If
Screen 0
EFFECT_SETTINGS(9)= Not EFFECT_SETTINGS(9)
End If
Else If EFFECT_SETTINGS(0)=4
Screen 2
If EFFECT_SETTINGS(9)
Get Palette 0
EFFECT_SETTINGS(9)=False
Else
If Rnd(10)=0
S=Start(45)
For I=0 To 31
Colour I,Deek(S) : S=S+2
Next
End If
EFFECT_SETTINGS(9)=True
End If
Screen 0
End If
End If
Screen ST
End Proc
Procedure NEWMENU_ROUTINE
On Error Proc INEXT_ERRORTRAP
Repeat
NEWMENU_RESET
NEWMENU_ADD["Equipment","Equipment and Inventory"]
NEWMENU_ADD["Load/Save","Load or Save a Game"]
NEWMENU_ADD["Stats","Statistics"]
NEWMENU_ADD["Cancel","Return To Game"]
NEWMENU_CHOICE
C=Param
If C<>3
NEWMENU_RESET
If C=0
Repeat
NEWMENU_RESET
NEWMENU_ADD["Equip","Equip A Weapon or Piece of Armor"]
NEWMENU_ADD["Use","Use An Item"]
NEWMENU_ADD["Main Menu","Return To Main Menu"]
NEWMENU_CHOICE
D=Param
If D<>2
If D=1
MITEM=-1
For I=5 To 261
If ITEMHAVE(I)>0
Inc MITEM
End If
Next
If MITEM>-1
VPOS=0
Repeat
NEWMENU_RESET
SPOS=VPOS+5 : QPOS=VPOS
CI=0 : IPOS=SPOS
Repeat
If ITEMHAVE(IPOS)>0
HP=Deek(Start(60)+ITEMHAVE(IPOS)*8+2)
NEWMENU_ADD[ITEMS$(ITEMHAVE(IPOS)),"Use "+ITEMS$(ITEMHAVE(IPOS))+" for"+Str$(HP)+" HP"]
MENU_VAR(CI)=IPOS
Inc CI
End If
If CI<6 : Inc IPOS : End If
Until IPOS=262 or CI=6
If CI=6 or VPOS>0
NEWMENU_ADD["More...","See More Items"]
End If
NEWMENU_ADD["Cancel","Return To Equip Menu"]
NEWMENU_CHOICE
F=Param
If CI=6
If F=6
Add VPOS,6,0 To MITEM
Else If F<6
If Deek(Start(60)+ITEMHAVE(MENU_VAR(F))*8+6)=4
HP=Deek(Start(60)+ITEMHAVE(MENU_VAR(F))*8+4)
RATINGS(0)=Min(RATINGS(0)+HP,RATINGS(1))
ITEM_REMFROMSPOT[MENU_VAR(F)]
ITEM_REORG
End If
End If
Else
If VPOS>0 and F=CI
VPOS=0
Else
If F<CI
If Deek(Start(60)+ITEMHAVE(MENU_VAR(F))*8+6)=4
HP=Deek(Start(60)+ITEMHAVE(MENU_VAR(F))*8+4)
RATINGS(0)=Min(RATINGS(0)+HP,RATINGS(1))
ITEM_REMFROMSPOT[MENU_VAR(F)]
ITEM_REORG
End If
End If
End If
End If
T1=(QPOS=0) and(CI<6) and(CI=F)
T2=((QPOS>0) or(CI<6)) and(F=CI+1)
T3=(CI=6) and(F=CI+1)
Until T1 or T2 or T3
End If
Else If D=0
Repeat
NEWMENU_RESET
NEWMENU_ADD["Weapon","Change From "+ITEMS$(ITEMHAVE(0))+" to Another Weapon"]
NEWMENU_ADD["Armor","Change From "+ITEMS$(ITEMHAVE(1))+" to Another Armor"]
NEWMENU_ADD["Gloves","Change From "+ITEMS$(ITEMHAVE(2))+" to Another Set Of Gloves"]
NEWMENU_ADD["Hat","Change From "+ITEMS$(ITEMHAVE(3))+" to Another Hat"]
NEWMENU_ADD["Cancel","Return To Equip Menu"]
NEWMENU_CHOICE
E=Param
If E<>4
VPOS=0 : MITEM=-1
For I=5 To 261
If ITEMHAVE(I)>0
ITN=ITEMHAVE(I)
T=Deek(Start(60)+ITN*8+6)
If T=E
Inc MITEM
End If
End If
Next
If MITEM>-1
Repeat
NEWMENU_RESET
Q=VPOS : SPOS=5 : QPOS=VPOS
Repeat
If ITEMHAVE(SPOS)>0
T=Deek(Start(60)+ITEMHAVE(SPOS)*8+6)
If T=E
Dec Q
End If
End If
If Q>-1 : Inc SPOS : End If
Until Q=-1 or SPOS=262
If SPOS=262 and Q>-1
Goto __OUTOFITEMS
End If
CI=0 : IPOS=SPOS
Repeat
If ITEMHAVE(IPOS)>0
T=Deek(Start(60)+ITEMHAVE(IPOS)*8+6)
If T=E
NEWMENU_ADD[ITEMS$(ITEMHAVE(IPOS)),"Switch To "+ITEMS$(ITEMHAVE(IPOS))]
MENU_VAR(CI)=IPOS
Inc CI
End If
End If
If CI<6 : Inc IPOS : End If
Until IPOS=262 or CI=6
If CI=6 or VPOS>0
NEWMENU_ADD["More...","See More Items"]
End If
NEWMENU_ADD["Cancel","Return To Equip Menu"]
NEWMENU_CHOICE
F=Param
If CI=6
If F=6
Add VPOS,6,0 To MITEM
Else If F<6
Swap ITEMHAVE(E),ITEMHAVE(MENU_VAR(F))
End If
Else
If VPOS>0 and F=CI
VPOS=0
Else
If F<CI
Swap ITEMHAVE(E),ITEMHAVE(MENU_VAR(F))
End If
End If
End If
T1=(QPOS=0) and(CI<6) and(CI=F)
T2=((QPOS>0) or(CI<6)) and(F=CI+1)
T3=(CI=6) and(F=CI+1)
Until T1 or T2 or T3
End If
__OUTOFITEMS:
Until E=4
End If
End If
End If
Until D=2
Else If C=1
NEWMENU_ADD["Load","Load A Game"]
NEWMENU_ADD["Save","Save A Game"]
NEWMENU_ADD["Main Menu","Return To Main Menu"]
Repeat
NEWMENU_CHOICE
D=Param
If D=0
Show On
FILE$=Fsel$("*.game","","Choose A Saved Game")
Hide On
If FILE$<>"" : If Exist(FILE$)
GAME_LOAD[FILE$]
D=2 : C=3
End If : End If
Else If D=1
Show On
FILE$=Fsel$("*.game","","Enter A Name For Your Saved Game")
Hide On
If FILE$<>""
GAME_SAVE[FILE$]
End If
End If
Until D=2
Else If C=2
NEWMENU_ADD["HP/MHP","HP:"+Str$(RATINGS(0))+"/"+Str$(RATINGS(1))]
A$="Str:"+Str$(RATINGS(2))
A$=A$+" Dex:"+Str$(RATINGS(3))
A$=A$+" Int:"+Str$(RATINGS(4))
NEWMENU_ADD["Str/Dex/Int",A$]
NEWMENU_ADD["Credits",Str$(RATINGS(5))+" Credits"]
A$=Str$(RATINGS(6))+"/"
Proc RATING_NEXTUP : NUP=Param
A$=A$+Str$(NUP)+" Experience to Next Level"
NEWMENU_ADD["Exp",A$]
Proc ITEM_CALCATTACK : AK=Param
Proc ITEM_CALCDEFENSE : DF=Param
A$="Attack:"+Str$(AK)
A$=A$+" Defence:"+Str$(DF)
NEWMENU_ADD["Atk/Def",A$]
NEWMENU_ADD["Main Menu","Return To Main Menu"]
Repeat
NEWMENU_CHOICE
D=Param
Until D=5
End If
End If
Until C=3
End Proc
Procedure NEWMENU_RESET
On Error Proc INEXT_ERRORTRAP
Shared MMENU
MMENU=-1
End Proc
Procedure NEWMENU_ADD[S$,L$]
On Error Proc INEXT_ERRORTRAP
Shared MMENU
Inc MMENU
NEWMENU$(MMENU,0)=S$
NEWMENU$(MMENU,1)=L$
End Proc
Procedure NEWMENU_CHOICE
On Error Proc INEXT_ERRORTRAP
Shared MMENU
S=Screen
Screen 2
FONT_FIND["XEN.font/8"]
Set Font Param
Gr Writing 0
SPEED=8
MENU_XPOS=Min(Max(CHAR_XPOS-MAP_XPOS,80),240)
MENU_YPOS=Min(Max(CHAR_YPOS-MAP_YPOS,60),130)
DMENU=MMENU+1
For I=0 To MMENU
ANG=(I*360)/DMENU
NEWMENU_POS(I,0)=MENU_XPOS+Sin(ANG)*50
NEWMENU_POS(I,1)=MENU_YPOS-Cos(ANG)*50
Next
CMENU=0
For FRAMES=0 To SPEED
Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0
For I=0 To MMENU
CI=(CMENU+I) mod DMENU
A=Text Length(NEWMENU$(CI,0))
A=A/2
XD=NEWMENU_POS(I,0)-MENU_XPOS
YD=NEWMENU_POS(I,1)-MENU_YPOS
XP=MENU_XPOS+(XD*FRAMES)/SPEED
YP=MENU_YPOS+(YD*FRAMES)/SPEED
DXP=XP-A-2 : CXP=XP+A+2
Cls MENU_COLORS(0),DXP,YP-10 To CXP,YP+2
Ink MENU_COLORS(1) : Polyline DXP,YP+2 To DXP,YP-10 To CXP,YP-10
Ink MENU_COLORS(2) : Polyline DXP,YP+2 To CXP,YP+2 To CXP,YP-10
Ink MENU_COLORS(3) : Text XP-A,YP-1,NEWMENU$(CI,0)
Next
Cls MENU_COLORS(0),0,190 To 320,200
Ink MENU_COLORS(1) : Polyline 0,190 To 319,190 To 319,199
Ink MENU_COLORS(2) : Polyline 0,190 To 0,199 To 319,199
Ink MENU_COLORS(3) : Text 2,197,NEWMENU$(OMENU,1)
Screen Swap : Beam Wait VB_LINE
Next
Repeat
Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0
For I=0 To MMENU
CI=(CMENU+I) mod DMENU
A=Text Length(NEWMENU$(CI,0))
A=A/2
XP=NEWMENU_POS(I,0) : YP=NEWMENU_POS(I,1)
DXP=XP-A-2 : CXP=XP+A+2
Cls MENU_COLORS(0),DXP,NEWMENU_POS(I,1)-10 To CXP,NEWMENU_POS(I,1)+2
Ink MENU_COLORS(1) : Polyline DXP,YP+2 To DXP,YP-10 To CXP,YP-10
Ink MENU_COLORS(2) : Polyline DXP,YP+2 To CXP,YP+2 To CXP,YP-10
Ink MENU_COLORS(3) : Text NEWMENU_POS(I,0)-A,NEWMENU_POS(I,1)-1,NEWMENU$(CI,0)
Next
Cls MENU_COLORS(0),0,190 To 320,200
Ink MENU_COLORS(1) : Polyline 0,190 To 319,190 To 319,199
Ink MENU_COLORS(2) : Polyline 0,190 To 0,199 To 319,199
Ink MENU_COLORS(3) : Text 2,197,NEWMENU$(CMENU,1)
Screen Swap : Beam Wait VB_LINE
OMENU=CMENU
Repeat
SNAPSHOT
J=Joy(1)
Multi Wait
Until J>0
If Btst(2,J)
Add CMENU,1,0 To MMENU
D=1
Else If Btst(3,J)
Add CMENU,-1,0 To MMENU
D=-1
End If
Repeat : Until Joy(1)=0
If OMENU<>CMENU
For FRAMES=0 To SPEED
Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0
For I=0 To MMENU
NI=(D+I+DMENU) mod DMENU
CI=(CMENU+I) mod DMENU
A=Text Length(NEWMENU$(CI,0))
A=A/2
XD=NEWMENU_POS(I,0)-NEWMENU_POS(NI,0)
YD=NEWMENU_POS(I,1)-NEWMENU_POS(NI,1)
XP=NEWMENU_POS(NI,0)+(XD*FRAMES)/SPEED
YP=NEWMENU_POS(NI,1)+(YD*FRAMES)/SPEED
DXP=XP-A-2 : CXP=XP+A+2
Cls MENU_COLORS(0),DXP,YP-10 To CXP,YP+2
Ink MENU_COLORS(1) : Polyline DXP,YP+2 To DXP,YP-10 To CXP,YP-10
Ink MENU_COLORS(2) : Polyline DXP,YP+2 To CXP,YP+2 To CXP,YP-10
Ink MENU_COLORS(3) : Text XP-A,YP-1,NEWMENU$(CI,0)
Next
Cls MENU_COLORS(0),0,190 To 320,200
Ink MENU_COLORS(1) : Polyline 0,190 To 319,190 To 319,199
Ink MENU_COLORS(2) : Polyline 0,190 To 0,199 To 319,199
Ink MENU_COLORS(3) : Text 2,197,NEWMENU$(OMENU,1)
Screen Swap : Beam Wait VB_LINE
Next
End If
Until Btst(4,J)
For FRAMES=SPEED To 0 Step -1
Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0
For I=0 To MMENU
CI=(CMENU+I) mod DMENU
A=Text Length(NEWMENU$(CI,0))
A=A/2
XD=NEWMENU_POS(I,0)-MENU_XPOS
YD=NEWMENU_POS(I,1)-MENU_YPOS
XP=MENU_XPOS+(XD*FRAMES)/SPEED
YP=MENU_YPOS+(YD*FRAMES)/SPEED
DXP=XP-A-2 : CXP=XP+A+2
Cls MENU_COLORS(0),DXP,YP-10 To CXP,YP+2
Ink MENU_COLORS(1) : Polyline DXP,YP+2 To DXP,YP-10 To CXP,YP-10
Ink MENU_COLORS(2) : Polyline DXP,YP+2 To CXP,YP+2 To CXP,YP-10
Ink MENU_COLORS(3) : Text XP-A,YP-1,NEWMENU$(CI,0)
Next
Ink MENU_COLORS(0) : Bar 0,190 To 320,200
Ink MENU_COLORS(1) : Polyline 0,190 To 319,190 To 319,199
Ink MENU_COLORS(2) : Polyline 0,190 To 0,199 To 319,199
Ink MENU_COLORS(3) : Text 2,197,NEWMENU$(OMENU,1)
Screen Swap : Beam Wait VB_LINE
Next
Screen S
End Proc[CMENU]
Procedure CLR_SETUP
On Error Proc INEXT_ERRORTRAP
For I=0 To 3
FIND_PEN[$111*(I*5)]
MENU_COLORS(I)=Param
Next
End Proc
Procedure MAP_ZONERESET
On Error Proc INEXT_ERRORTRAP
Reserve Zone 256
Reserve As Work 62,6000
End Proc
Procedure MAP_ZONESET[WHICH,X1,Y1,X2,Y2,TYPE]
On Error Proc INEXT_ERRORTRAP
If X1>X2 : Swap X1,X2 : End If
If Y1>Y2 : Swap Y1,Y2 : End If
X2=Min(X2,Screen Width-1)
Y2=Min(Y2,Screen Height-1)
_X1=X1 : _X2=X2 : _Y1=Y1 : _Y2=Y2 : _WHICH=WHICH
Set Zone WHICH+1,X1,Y1 To X2,Y2
Loke Start(62)+(WHICH*20),TYPE
End Proc
Procedure MAP_ZONESETVAR[WHICH,VAR,VL]
On Error Proc INEXT_ERRORTRAP
Loke Start(62)+(WHICH*20)+4+(VAR*4),VL
End Proc
Procedure MAP_ZONEGETVAR[WHICH,VAR]
On Error Proc INEXT_ERRORTRAP
End Proc[Leek(Start(62)+(WHICH*20)+4+(VAR*4))]
Procedure MAP_ZONECHECK[X,Y]
On Error Proc INEXT_ERRORTRAP
ZNE_CHECKED=Zone(X,Y)-1
If ZNE_CHECKED>-1
T=Leek(Start(62)+ZNE_CHECKED*20)
Else
T=-1
End If
End Proc[T]
Procedure CHAR_COLLIDE[DIST]
On Error Proc INEXT_ERRORTRAP
P=-1 : DX=DIST : DY=DIST
If SCR_MAX>0
For I=1 To SCR_MAX
X=Abs(X Bob(I)-CHAR_XPOS)
Y=Abs(Y Bob(I)-CHAR_YPOS)
If X<DX and Y<DY
DX=Min(X,DX) : DY=Min(Y,DY) : P=I
End If
Next
End If
End Proc[P]
Procedure CHAR_FACE[C1,C2]
On Error Proc INEXT_ERRORTRAP
NEWFRAME_CHANGE[C1] : A=Param
NEWFRAME_CHANGE[C2] : A=(A or Param)
If Not A
CHAR_MOVEDIFF(C1,0)=X Bob(C1)+(X Bob(C1)-X Bob(C2))
CHAR_MOVEDIFF(C1,1)=Y Bob(C1)+(Y Bob(C1)-Y Bob(C2))
CHAR_MOVEDIFF[C1]
CHAR_MOVEDIFF(C2,0)=X Bob(C2)+(X Bob(C2)-X Bob(C1))
CHAR_MOVEDIFF(C2,1)=Y Bob(C2)+(Y Bob(C2)-Y Bob(C1))
CHAR_MOVEDIFF[C2]
End If
End Proc
Procedure FONT_FIND[NAME$]
On Error Proc INEXT_ERRORTRAP
NAME$=Upper$(NAME$)
Get Rom Fonts : S=1 : F=-1
Repeat
If Font$(S)<>""
A$=Upper$(Lword(1,Font$(S))+"/"+Lword(2,Font$(S)))
If A$=NAME$ : F=S : SKIP=True : End If
S=S+1
End If
Until SKIP or Font$(S)=""
If Not SKIP
Get Disc Fonts : S=1
Repeat
If Font$(S)<>""
A$=Upper$(Lword(1,Font$(S))+"/"+Lword(2,Font$(S)))
If A$=NAME$ : F=S : SKIP=True : End If
S=S+1
End If
Until SKIP or Font$(S)=""
End If
End Proc[F]
Procedure TXT_REPLACE[O$,S$,R$]
On Error Proc INEXT_ERRORTRAP
A=Instr(O$,S$)
If A>0
Repeat
O$=Left$(O$,A-1)+R$+Mid$(O$,A+Len(S$))
A=Instr(O$,S$)
Until A=0
End If
End Proc[O$]
Procedure FIND_PEN[CLR]
On Error Proc INEXT_ERRORTRAP
SC=Screen Colour-1
MX=200 : MZ=-1
For I=0 To SC
A=Colour(I) : Z=1 : E=0
For J=0 To 2
E=E+Abs(((A/Z) and 15)-((CLR/Z) and 15))
Z=Z*16
Next
If E<MX : MX=E : MZ=I : End If
Next
End Proc[MZ]
Procedure DISPLAY_OPEN
On Error Proc INEXT_ERRORTRAP
If DISP_ISOPEN=False
S=Screen
Screen 2
FONT_FIND["helvetica.font/15"]
Set Font Param
Set Text 2
Gr Writing 0
DISP_ISOPEN=True
Screen S
End If
End Proc
Procedure DISPLAY_CLOSE
On Error Proc INEXT_ERRORTRAP
If DISP_ISOPEN=True
DISP_ISOPEN=False
Screen S
End If
End Proc
Procedure DISPLAY_FIGOPTIONS
On Error Proc INEXT_ERRORTRAP
DISP_OPTION=-1
For I=0 To TXT_POS-1
If Left$(DISPLAY$(I),1)="!"
DISP_OPTION=I : I=TXT_POS
End If
Next
End Proc
Procedure DISPLAY_TEXT
On Error Proc INEXT_ERRORTRAP
If Not DISP_ISOPEN
DISPLAY_OPEN
End If
S=Screen : Screen 2
Screen Copy 0,MAP_XPOS,MAP_YPOS,MAP_XPOS+320,MAP_YPOS+200 To 2,0,0
EFFECT_LAYDOWN
BY=(TXT_POS-1)*19+24
Gr Writing 1 : Ink MENU_COLORS(0),MENU_COLORS(1)
Set Pattern 32
Bar 0,0 To 320,BY
Set Pattern 0
Gr Writing 0
Ink MENU_COLORS(1) : Box 0,0 To 319,BY
Ink MENU_COLORS(2) : Polyline 0,BY To 0,0 To 320,0
For I=0 To TXT_POS-1
D=(I*19)+16
If Left$(DISPLAY$(I),1)="!"
X=24 : A$=Mid$(DISPLAY$(I),2)
Else
X=4 : A$=DISPLAY$(I)
End If
Ink MENU_COLORS(2) : Text X-1,D,A$
Ink MENU_COLORS(1) : Text X+1,D,A$
Ink MENU_COLORS(3) : Text X,D,A$
If I=DISP_OPTION
DPOINTER[5,D-15]
End If
Next
Screen Swap : Beam Wait VB_LINE
Screen S
End Proc
Procedure DISPLAY_WAIT
On Error Proc INEXT_ERRORTRAP
If DISP_GO
SNAPSHOT
If(DISP_OPTION>-1) and(Joy(1) and 3)<>0
If Jup(1) : M=-1 : End If
If Jdown(1) : M=1 : End If
Repeat
Add DISP_OPTION,M,0 To TXT_POS-1
Until Left$(DISPLAY$(DISP_OPTION),1)="!"
DISPLAY_TEXT
Repeat : Until Joy(1)=0
End If
If Fire(1)
If DISP_OPTION>-1
SCRIPT_JUMP[TXT_GRAB,DISPLAY_JUMP$(DISP_OPTION)]
End If
DISP_GO=False : TXT_POS=0
Repeat : Until Fire(1)=True
Repeat : Until Fire(1)=False
End If
End If
End Proc
Procedure AA_FONT[X,Y,TXT$]
On Error Proc INEXT_ERRORTRAP
Ink MENU_COLORS(1) : Text X-1,Y,TXT$
Ink MENU_COLORS(2) : Text X+1,Y,TXT$
Ink MENU_COLORS(3) : Text X,Y,TXT$
End Proc
Procedure AA_REVFONT[X,Y,TXT$]
On Error Proc INEXT_ERRORTRAP
Ink MENU_COLORS(1) : Text X-1,Y,TXT$
Ink MENU_COLORS(2) : Text X+1,Y,TXT$
Ink MENU_COLORS(0) : Text X,Y,TXT$
End Proc
Procedure AA_BOX[X1,Y1,X2,Y2]
On Error Proc INEXT_ERRORTRAP
Ink MENU_COLORS(1) : Box X1,Y1 To X2,Y2
Box X1+1,Y1+1 To X2-1,Y2-1
Ink MENU_COLORS(2) : Polyline X1,Y2 To X1,Y1 To X2,Y1
Polyline X1+1,Y2-1 To X1+1,Y1+1 To X2-1,Y1+1
End Proc
Procedure AA_BAR[X1,Y1,X2,Y2]
On Error Proc INEXT_ERRORTRAP
Cls 2,X1,Y1 To X2,Y2
AA_BOX[X1,Y1,X2,Y2]
End Proc
Procedure ITEM_CALCATTACK
On Error Proc INEXT_ERRORTRAP
ITEM_STATS[ITEMS$(ITEMHAVE(0)),"WEAPON"]
A=Param+(RATINGS(2)/4)+(RATINGS(4)/8)
End Proc[A]
Procedure ITEM_CALCDEFENSE
On Error Proc INEXT_ERRORTRAP
ITEM_STATS[ITEMS$(ITEMHAVE(1)),"ARMOR"] : A=Param
ITEM_STATS[ITEMS$(ITEMHAVE(2)),"ARMOR"] : A=A+Param
ITEM_STATS[ITEMS$(ITEMHAVE(3)),"ARMOR"] : A=A+Param
A=A+(RATINGS(3)/4)+(RATINGS(4)/8)
End Proc[A]
Procedure ITEM_PREP
On Error Proc INEXT_ERRORTRAP
Shared ITEM_CURR
Reserve As Work 60,2048
ITEMS$(0)="Nothing"
ITEM_CURR=1
Open In 3,"items.data"
Set Input 10,-1
Repeat
Line Input #3,A$
If Lwords(A$)=6
NAME$=Lword(1,A$)
WP=Val(Lword(2,A$))
AP=Val(Lword(3,A$))
HP=Val(Lword(4,A$))
CS=Val(Lword(5,A$))
TYPE=Val(Lword(6,A$))
ITEM_ADDNAME[NAME$,WP,AP,HP,CS,TYPE]
End If
Until Eof(3)
Close 3
End Proc
Procedure ITEM_ADDNAME[NAME$,WP,AP,HP,CS,TYPE]
On Error Proc INEXT_ERRORTRAP
Shared ITEM_CURR
ITEMS$(ITEM_CURR)=NAME$
S=Start(60)+(ITEM_CURR*8)
Poke S,WP
Poke S+1,AP
Doke S+2,HP
Doke S+4,CS
Doke S+6,TYPE
Inc ITEM_CURR
End Proc
Procedure ITEM_REORG
On Error Proc INEXT_ERRORTRAP
For I=260 To 5 Step -1
If ITEMHAVE(I)>0
S=I : I=5
End If
Next
For I=5 To S
If ITEMHAVE(I)=0
For J=I+1 To 261
ITEMHAVE(J-1)=ITEMHAVE(J)
Next
ITEMHAVE(261)=0
End If
Next
End Proc
Procedure ITEM_WHICH[NAME$]
On Error Proc INEXT_ERRORTRAP
Shared ITEM_CURR
NAME$=Upper$(NAME$) : RES=0
For I=1 To ITEM_CURR-1
If NAME$=Upper$(ITEMS$(I))
RES=I : I=ITEM_CURR
End If
Next
End Proc[RES]
Procedure ITEM_INSPOT[SPOT]
On Error Proc INEXT_ERRORTRAP
End Proc[ITEMS$(ITEMHAVE(SPOT))]
Procedure ITEM_REMFROMSPOT[SPOT]
On Error Proc INEXT_ERRORTRAP
A$=ITEMS$(ITEMHAVE(SPOT))
ITEMHAVE(SPOT)=0
End Proc[A$]
Procedure ITEM_ADDTOSPOT[NAME$,SPOT]
On Error Proc INEXT_ERRORTRAP
ITEM_WHICH[NAME$] : WHICH=Param
ITEMHAVE(SPOT)=WHICH
End Proc
Procedure ITEM_ADDNUMSPOT[NUM,SPOT]
On Error Proc INEXT_ERRORTRAP
ITEMHAVE(SPOT)=NUM
End Proc
Procedure ITEM_ADD[NAME$]
On Error Proc INEXT_ERRORTRAP
For I=5 To 261
If ITEMHAVE(I)=0
ITEM_WHICH[NAME$]
ITEMHAVE(I)=Param : I=261
End If
Next
End Proc
Procedure ITEM_REMV[NAME$]
On Error Proc INEXT_ERRORTRAP
ITEM_WHICH[NAME$] : WHICH=Param
For I=5 To 261
If ITEMHAVE(I)=WHICH
ITEMHAVE(I)=0 : I=261 : RES=True
End If
Next
End Proc[RES]
Procedure ITEM_HAVE[NAME$]
On Error Proc INEXT_ERRORTRAP
ITEM_WHICH[NAME$] : WHICH=Param
For I=5 To 261
If ITEMHAVE(I)=WHICH
I=261 : RES=True
End If
Next
End Proc[RES]
Procedure ITEM_STATS[NAME$,WHICH$]
On Error Proc INEXT_ERRORTRAP
ITEM_WHICH[NAME$] : WHICH=Param
A=0
If WHICH>0
WHICH=Start(60)+WHICH*8
WHICH$=Upper$(WHICH$)
If WHICH$="WEAPON"
A=Peek(WHICH)
Else If WHICH$="ARMOR"
A=Peek(WHICH+1)
Else If WHICH$="HP"
A=Deek(WHICH+2)
Else If WHICH$="COST"
A=Deek(WHICH+4)
Else If WHICH$="TYPE"
A=Deek(WHICH+6)
End If
End If
End Proc[A]
Procedure RATING_ADD[NAME$,V]
On Error Proc INEXT_ERRORTRAP
NAME$=Upper$(NAME$)
For I=0 To 5
Read A$
If A$=NAME$
RATINGS(I)=RATINGS(I)+V
End If
Next
Pop Proc
Data "HP","MHP","STR","INT","DEX","CRED"
End Proc
Procedure RATING_SET[NAME$,V]
On Error Proc INEXT_ERRORTRAP
NAME$=Upper$(NAME$)
For I=0 To 5
Read A$
If A$=NAME$
RATINGS(I)=V
End If
Next
Pop Proc
Data "HP","MHP","STR","INT","DEX","CRED"
End Proc
Procedure RATING_GET[NAME$]
On Error Proc INEXT_ERRORTRAP
NAME$=Upper$(NAME$)
For I=0 To 5
Read A$
If A$=NAME$
V=RATINGS(I)
End If
Next
Data "HP","MHP","STR","INT","DEX","CRED"
End Proc[V]
Procedure RATING_NEXTUP
On Error Proc INEXT_ERRORTRAP
NXTUP=(RATINGS(1)*1.2)+(RATINGS(2)+RATINGS(3)+RATINGS(4)-15)*12
End Proc[NXTUP]
Procedure FIGHT_SETUP[GROUP]
On Error Proc INEXT_ERRORTRAP
Shared ENEMY_CURRMARK,NOKILL,ENEMY_GROUP
SCRIPT_GETGROUP[GROUP]
If ENEMY_MAX>-1
ENEMY_GROUP=GROUP/10
NOKILL=(GROUP>99)
ENEMY_CURRMARK=-1
Reserve As Work 65,(ENEMY_MAX+2)*16
POS_START=Start(65)
NEWFRAME_RESET
For I=0 To ENEMY_MAX
ANG=(I*360)/(ENEMY_MAX+1)
DX=CHAR_XPOS+Sin(ANG)*50
DY=CHAR_YPOS-Cos(ANG)*50
WE=FIGHT_ENEMIES(I)
Loke POS_START+(I*16),DX-X Bob(WE)
Loke POS_START+(I*16)+4,DY-Y Bob(WE)
Loke POS_START+(I*16)+8,X Bob(WE)
Loke POS_START+(I*16)+12,Y Bob(WE)
FIGHT_RESPONSE(I)=0
Next
FIGHT_RESPONSE(16)=0
NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+4,False]
For I=4 To 7
NEWFRAME_GRABSET[CHAR_FRAMEBASE(0)+I]
Next
For J=0 To ENEMY_MAX
For K=4 To 7
NEWFRAME_GRABSET[CHAR_FRAMEBASE(FIGHT_ENEMIES(J))+K]
Next
NEWFRAME_SET[FIGHT_ENEMIES(J),CHAR_FRAMEBASE(FIGHT_ENEMIES(J))+6,False]
Next
NEWFRAME_GRABSET[4090]
NEWFRAME_FULLREQUEST
For I=1 To 10
HEI=Sin((I*180)/10)*20
ALLDONE=True
For J=0 To ENEMY_MAX
BX=Leek(POS_START+J*16+8) : DX=Leek(POS_START+J*16)
BY=Leek(POS_START+J*16+12) : DY=Leek(POS_START+J*16+4)
PX=BX+(DX*I)/10
PY=BY+(DY*I)/10-HEI
Bob FIGHT_ENEMIES(J),PX,PY,
'CHAR_MOVEDIFF[FIGHT_ENEMIES(J)]
Next
NEWFRAME_MOVE[0,False]
MAP_DISPLAY
Next
For J=0 To EMENY_MAX
NEWFRAME_SET[FIGHT_ENEMIES(J),CHAR_FRAMEBASE(FIGHT_ENEMIES(J))+4,False]
Next
Repeat
ALLDONE=True
For J=0 To ENEMY_MAX
NEWFRAME_MOVE[FIGHT_ENEMIES(J),False]
ALLDONE=ALLDONE and Param
Next
NEWFRAME_MOVE[0,False]
ALLDONE=ALLDONE and Param
MAP_DISPLAY
Until ALLDONE
'Fight Data
'AABBCCCDD: AA (10000000) Attack
' BB (100000) Defense
' CCC
CM=-1
For J=0 To ENEMY_MAX
FIGHT_ATTACK(J)=FIGHT_POWER(J)/10000000
FIGHT_DEFENSE(J)=(FIGHT_POWER(J)/100000) mod 100
FIGHT_HP(J)=(FIGHT_POWER(J)/100) mod 1000
CM=Max(FIGHT_POWER(J) mod 100,CM)
Next
RATING_GET["DEX"]
FRSPEED=Param
CM=Max(FRSPEED,CM)
For J=0 To ENEMY_MAX
FIGHT_CHARGE(J)=((FIGHT_POWER(J) mod 100)*15)/CM
Next
FIGHT_CHARGE(16)=(FRSPEED*15)/CM
For J=0 To ENEMY_MAX
NEWFRAME_SET[FIGHT_ENEMIES(J),CHAR_FRAMEBASE(FIGHT_ENEMIES(J))+5,False]
Next
NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+5,False]
MAP_DISPLAY
SOUND_PLAY["RPG:Sounds/Fight.iff",15,8000,236]
FIGHT_SCREENOPEN
FIGHT
FIGHT_SCREENCLOSE
End If
End Proc[ENEMY_MAX]
Procedure FIGHT_SCREENOPEN
On Error Proc INEXT_ERRORTRAP
S=Screen
Screen 2
FONT_FIND["XEN.font/8"]
Set Font Param
Screen Open 1,320,24,8,Lowres : Flash Off : Curs Off : Cls 0
Screen Hide 1
Double Buffer : Autoback 0
FONT_FIND["XEN.font/8"]
Set Font Param
Gr Writing 0
Palette $0,$111,$222,$333,$444,$555,$666,$FFF
If CHAR_YPOS-MAP_YPOS<100
Screen Display 1,,226,,0
Else
Screen Display 1,,50,,0
End If
FIGHT_SCREENUPDATE
Screen Show 1
For I=0 To 24 Step 4
Screen Display 1,,,,I
Beam Wait VB_LINE
Next
Screen Display 1,,,,24
FIGHT_ENEMYWHICH[0]
Screen S
End Proc
Procedure FIGHT_SCREENCLOSE
On Error Proc INEXT_ERRORTRAP
For I=24 To 0 Step -4
Screen Display 1,,,,I
Beam Wait VB_LINE
Next
Screen Close 1
End Proc
Procedure FIGHT_BACKDROP
On Error Proc INEXT_ERRORTRAP
For I=0 To 6
Cls I,0,(I*24)/7 To 320,((I+1)*24)/7
Next
End Proc
Procedure FIGHT_SCREENUPDATE
On Error Proc INEXT_ERRORTRAP
Shared FIGHT_CURROPTION
S=Screen : Screen 1
FIGHT_BACKDROP
If FIGHT_CURROPTION=0
A$="Attack"
Else If FIGHT_CURROPTION=1
A$="LightHeal"
Else If FIGHT_CURROPTION=2
A$="SmartHeal"
Else
A$="MaxHeal"
End If
If FIGHT_RESPONSE(16)=150
AA_FONT[2,16,A$]
Else
AA_REVFONT[2,16,A$]
End If
Cls 0,84,8 To 160,16
Cls 7,84,8 To 84+(FIGHT_RESPONSE(16)*76)/150,16
AA_BOX[84,8,160,16]
RATING_GET["HP"] : HP=Param
RATING_GET["MHP"] : MHP=Param
A$="HP:"+(Str$(HP)-" ")+"/"+(Str$(MHP)-" ")
AA_FONT[180,16,A$]
Screen Copy Logic(1) To Physic(1) : Wait Vbl
Screen S
End Proc
Procedure FIGHT_TEXT[TXT$]
On Error Proc INEXT_ERRORTRAP
S=Screen : Screen 1
FIGHT_BACKDROP
AA_FONT[4,16,TXT$]
Screen Copy Logic To Physic : Beam Wait VB_LINE
Screen S
End Proc
Procedure FIGHT
On Error Proc INEXT_ERRORTRAP
Shared ENEMY_CURRMARK,FIGHT_CURROPTION,NOKILL,ENEMY_GROUP
Shared _ATTACK,_DEFENSE
FIGHT_END=False
RATING_GET["DEX"]
FRSPEED=Param
RATING_GET["INT"]
SMARTS=Param
Proc ITEM_CALCATTACK : _ATTACK=Param
Proc ITEM_CALCDEFENSE : _DEFENSE=Param
CASH=0
FIGHT_CURROPTION=0
FS_POS=((CHAR_YPOS-MAP_YPOS)<100)
For I=0 To 15
HIT_PERCENT=Max(HIT_PERCENT,FIGHT_ATTACK(I)+FIGHT_DEFENSE(I))
Next
HIT_PERCENT=Max(HIT_PERCENT,(_ATTACK+_DEFENSE))
Do
If Key State(88)
If Not FS_POS
Screen Display 1,,226,,0
Else
Screen Display 1,,50,,0
End If
Repeat : Until Not Key State(88)
FS_POS= Not FS_POS
End If
If Jleft(1)
D=ENEMY_CURRMARK
Repeat
Add D,-1,0 To ENEMY_MAX
Until FIGHT_HP(D)>0
FIGHT_ENEMYWHICH[D]
Else If Jright(1)
D=ENEMY_CURRMARK
Repeat
Add D,1,0 To ENEMY_MAX
Until FIGHT_HP(D)>0
FIGHT_ENEMYWHICH[D]
Else If Jup(1)
Add FIGHT_CURROPTION,-1,0 To 3
JS_WAIT
Else If Jdown(1)
Add FIGHT_CURROPTION,1,0 To 3
JS_WAIT
Else If Fire(1) and FIGHT_RESPONSE(16)=150
FIGHT_RESPONSE(16)=0
If FIGHT_CURROPTION=0
CE=ENEMY_CURRMARK
FIGHT_ENEMYWHICH[-1]
WB=FIGHT_ENEMIES(CE)
DX=(X Bob(WB)-4)-CHAR_XPOS
DY=(Y Bob(WB)+4)-CHAR_YPOS
NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+6,False] : OSET=Param
For I=1 To 10
HEI=Sin((I*180)/10)*20
PX=CHAR_XPOS+(DX*I)/10
PY=CHAR_YPOS+(DY*I)/10-HEI
Bob 0,PX,PY,
MAP_DISPLAY
Next
HIT=_ATTACK+_DEFENSE
If Rnd(HIT_PERCENT)<HIT
YOUR_ATK=Rnd(0.2*_ATTACK)+(0.9*_ATTACK)
If Rnd(10)=0
YOUR_ATK=(YOUR_ATK*5)/4
S=Screen : Screen 2
For I=0 To 31
Colour I,$FFF
Next
Fade 2 To 0 : Screen S
End If
DMG=YOUR_ATK-FIGHT_DEFENSE(CE)
If DMG>0
FIGHT_HP(CE)=FIGHT_HP(CE)-DMG
A$=Str$(DMG)-" "
Else
A=YOUR_ATK*0.1
If A>0
DMG=Max(1,Rnd(A))
Else
DMG=1
End If
FIGHT_HP(CE)=FIGHT_HP(CE)-DMG
A$=Str$(DMG)-" "
End If
Else
A$="Missed!"
End If
NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+7,False]
SOUND_PLAY["RPG:Sounds/Fight0x.iff",15,8000,236]
Repeat
MAP_DISPLAY
NEWFRAME_MOVE[0,False]
Until Param
MAP_DISPLAY
Wait 5
NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+6,False]
For I=10 To 0 Step -1
HEI=Sin((I*180)/10)*20
PX=CHAR_XPOS+(DX*I)/10
PY=CHAR_YPOS+(DY*I)/10-HEI
Bob 0,PX,PY,
MAP_DISPLAY
Next
NEWFRAME_SET[0,OSET,False]
MAP_DISPLAY
FIGHT_NUMBERBOUNCE[CE,A$]
If FIGHT_HP(CE)<1
If Not NOKILL : Bob WB,-50,-50, : End If
RATINGS(6)=RATINGS(6)+(FIGHT_ATTACK(CE)+FIGHT_DEFENSE(CE))
CASH=CASH+Rnd(FIGHT_ATTACK(CE)+FIGHT_DEFENSE(CE))+2
MAP_DISPLAY
EDCNT=0
Repeat
Add CE,1,0 To ENEMY_MAX
If FIGHT_HP(CE)<1 : Inc EDCNT : End If
Until FIGHT_HP(CE)>0 or EDCNT=>ENEMY_MAX
If EDCNT=>ENEMY_MAX
Goto __BATTLEEND
End If
End If
FIGHT_ENEMYWHICH[CE]
Else
If FIGHT_CURROPTION=1
MX=$FFFF
Else
MX=0
End If
MZ=-1
For I=5 To 261
If ITEMHAVE(I)>0
If Deek(Start(60)+ITEMHAVE(I)*8+6)=4
IHP=Deek(Start(60)+ITEMHAVE(I)*8+2)
If FIGHT_CURROPTION=1
If IHP<MX
MX=IHP : MZ=I
End If
Else If FIGHT_CURROPTION=2
If IHP>MX and IHP<RATINGS(1)
MX=IHP : MZ=I
End If
Else If FIGHT_CURROPTION=3
If IHP>MX
MX=IHP : MZ=I
End If
End If
End If
End If
Next
If MZ>-1
RATINGS(0)=Min(RATINGS(0)+MX,RATINGS(1))
ITEM_REMFROMSPOT[MZ]
ITEM_REORG
A$="+"+(Str$(MX)-" ")
FIGHT_NUMBERBOUNCE[-1,A$]
Else
FIGHT_RESPONSE(16)=150
End If
End If
End If
For J=0 To ENEMY_MAX
If FIGHT_RESPONSE(J)=150 and FIGHT_HP(J)>0
CE=ENEMY_CURRMARK
FIGHT_ENEMYWHICH[-1]
EB=FIGHT_ENEMIES(J)
EX=X Bob(EB) : EY=Y Bob(EB)
DX=(CHAR_XPOS-4)-EX
DY=(CHAR_YPOS+4)-EY
NEWFRAME_SET[EB,CHAR_FRAMEBASE(EB)+6,False] : OSET=Param
For I=1 To 10
HEI=Sin((I*180)/10)*20
PX=EX+(DX*I)/10
PY=EY+(DY*I)/10-HEI
Bob EB,PX,PY,
MAP_DISPLAY
Next
HIT=FIGHT_ATTACK(J)+FIGHT_DEFENSE(J)
If Rnd(HIT_PERCENT)<HIT
HISATK=Rnd(0.2*FIGHT_ATTACK(J))+(0.9*FIGHT_ATTACK(J))
If Rnd(10)=0
HISATK=(HISATK*5)/4
S=Screen : Screen 2
For I=0 To 31 : Colour I,$FFF : Next
Fade 2 To 0 : Screen S
End If
DMG=HISATK-_DEFENSE
If DMG>0
RATING_GET["HP"]
HP=Param-DMG
RATING_SET["HP",HP]
A$=Str$(DMG)-" "
Else
A=HISATK*0.1
If A>0
DMG=Max(1,Rnd(A))
Else
DMG=1
End If
RATING_GET["HP"]
HP=Param-DMG
RATING_SET["HP",HP]
A$=Str$(DMG)-" "
End If
Else
A$="Missed!"
HP=69
End If
NEWFRAME_SET[EB,CHAR_FRAMEBASE(EB)+7,False]
SOUND_PLAY["RPG:Sounds/fight"+(Str$(ENEMY_GROUP)-" ")+"x.iff",15,8000,236]
Repeat
MAP_DISPLAY
NEWFRAME_MOVE[EB,False]
Until Param
MAP_DISPLAY
Wait 5
NEWFRAME_SET[EB,CHAR_FRAMEBASE(EB)+6,False]
NEWFRAME_SET[EB,CHAR_FRAMEBASE(EB)+6,False]
For I=10 To 0 Step -1
HEI=Sin((I*180)/10)*20
PX=EX+(DX*I)/10
PY=EY+(DY*I)/10-HEI
Bob EB,PX,PY,
MAP_DISPLAY
Next
FIGHT_RESPONSE(J)=0
NEWFRAME_SET[EB,OSET,False]
MAP_DISPLAY
FIGHT_NUMBERBOUNCE[-1,A$]
If HP<1
IMDEAD=True
Goto __BATTLEEND
End If
FIGHT_ENEMYWHICH[CE]
End If
Next
If RESP_UPDATE=2
For I=0 To ENEMY_MAX
FIGHT_RESPONSE(I)=FIGHT_RESPONSE(I)+(FIGHT_CHARGE(I)/2)+Rnd(FIGHT_CHARGE(I)/2)
If FIGHT_RESPONSE(I)>150 : FIGHT_RESPONSE(I)=150 : End If
Next
FIGHT_RESPONSE(16)=FIGHT_RESPONSE(16)+(FIGHT_CHARGE(16)/2)+Rnd(FIGHT_CHARGE(16)/2)
If FIGHT_RESPONSE(16)>150 : FIGHT_RESPONSE(16)=150 : End If
End If
Add RESP_UPDATE,1,0 To 2
FIGHT_SCREENUPDATE
SCRNSAVER_KILL
SNAPSHOT
Loop
__BATTLEEND:
If Not IMDEAD
Repeat : Until Joy(1)=0
NEWFRAME_SET[0,CHAR_FRAMEBASE(0)+4,True]
Repeat
MAP_DISPLAY
NEWFRAME_MOVE[0,True]
Until Param
MAP_DISPLAY
FIGHT_TEXT["Earned"+Str$(CASH)+" Credits"]
T=Timer+200
Repeat : Until Joy(1)>0 or Timer>T
Repeat : Until Joy(1)=0
RATINGS(5)=RATINGS(5)+CASH
Proc RATING_NEXTUP : NXTUP=Param
If RATINGS(6)=>NXTUP
PTS=11 : RPTS=4 : I=1
Repeat
If I=1
If Rnd(1)=0
RATINGS(1)=RATINGS(1)+1
PTS=PTS-1
End If
Else
If Rnd(5)=0 and RPTS>0
RATINGS(I)=RATINGS(I)+1
PTS=PTS-1
RPTS=RPTS-1
End If
End If
Add I,1,1 To 4
Until PTS=0
FIGHT_TEXT["Level Up!! "+Str$(7+RPTS)+" HP Gained!"]
T=Timer+200
Repeat : Until Joy(1)>0 or Timer>T
Repeat : Until Joy(1)=0
RATINGS(6)=RATINGS(6)-NXTUP
End If
Else
Wait 60
End If
Bob Off 64
Screen 0
Erase 236
End Proc
Procedure FIGHT_NUMBERBOUNCE[WHICH,TXT$]
On Error Proc INEXT_ERRORTRAP
S=Screen : Screen 2
If WHICH=-1
X=X Bob(0)-MAP_XPOS
Y=Y Bob(0)-MAP_YPOS
Else
X=X Bob(FIGHT_ENEMIES(WHICH))-MAP_XPOS
Y=Y Bob(FIGHT_ENEMIES(WHICH))-MAP_YPOS
End If
D=8 : L=Text Length(TXT$)
L=L/2
Screen Copy Physic To Logic
DX=(X-L) and $FFF8
DY=Y-28
If DX+(L*2)+8>312 : DX=312-((L*2)+8) : End If
If DX<0 : DX=0 : End If
If DY<0 : DY=0 : End If
If DY+38>199 : DY=161 : End If
Get Block 400,DX,DY,L*2+8,38,1
Repeat
For I=D To 0 Step -1
Ink 0 : Text X-L-1,Y-8-I,TXT$
Text X-L+1,Y-8-I,TXT$
Ink 31 : Text X-L,Y-8-I,TXT$
Screen Swap : Beam Wait VB_LINE
Put Block 400
Next
D=D/2
Until D=0
Wait 25
Put Block 400
Screen Swap : Beam Wait VB_LINE
Screen S
End Proc
Procedure FIGHT_ENEMYWHICH[WHICH]
On Error Proc INEXT_ERRORTRAP
Shared ENEMY_CURRMARK
S=Screen : Screen 2
MAP_DISPLAY
'Screen Copy Physic To Logic
Autoback 1
'If ENEMY_CURRMARK>-1
' BW=Deek(Sprite Base(I Bob(FIGHT_ENEMIES(ENEMY_CURRMARK))))*8
' BH=Deek(Sprite Base(I Bob(FIGHT_ENEMIES(ENEMY_CURRMARK)))+2)
' BX=X Bob(FIGHT_ENEMIES(ENEMY_CURRMARK))-MAP_XPOS
' BY=Y Bob(FIGHT_ENEMIES(ENEMY_CURRMARK))-MAP_YPOS
' 'Box BX-BW,BY-BH To BX+BW,BY
' ENEMY_CURRMARK=-1
'End If
If WHICH>-1
BW=Deek(Sprite Base(I Bob(FIGHT_ENEMIES(WHICH))))*8
BH=Deek(Sprite Base(I Bob(FIGHT_ENEMIES(WHICH)))+2)
BX=X Bob(FIGHT_ENEMIES(WHICH))-MAP_XPOS
BY=Y Bob(FIGHT_ENEMIES(WHICH))-MAP_YPOS
DPOINTER[BX-BW-16,BY-(BH/2)-8]
'Plot BX-BW,BY-BH
'Box BX-BW,BY-BH To BX+BW,BY
ENEMY_CURRMARK=WHICH
End If
Autoback 0
Screen S
End Proc
Procedure JS_WAIT
On Error Proc INEXT_ERRORTRAP
Repeat : Until Joy(1)=0
End Proc
Procedure NEWFRAME_SETUP
Shared FRAMES_MAX,PIC_POINTER
On Error Proc INEXT_ERRORTRAP
Reserve As Work 66,64000
FRAME_PTR=Start(66)
Reserve As Work 43,2048
Reserve As Work 26,4096
Open In 3,"frames.data"
Set Input 10,-1
Line Input #3,FRAMES_FILE$
CFP=0
Repeat
Line Input #3,A$
If Not Eof(3)
A=Lwords(A$)
F=Val(Lword(1,A$))
C=Val(Lword(2,A$))
Doke FRAME_PTR+1024+F*2,CFP
Q=CFP : CFP=CFP+2
TF=-1
For I=3 To A
D=Val(Lword(I,A$))
If D>0
Doke FRAME_PTR+9216+CFP,D
CFP=CFP+2 : TF=TF+1
End If
Next
Doke FRAME_PTR+9216+Q,TF
Doke FRAME_PTR+9216+CFP,C : CFP=CFP+2
If F>FRAMES_MAX
FRAMES_MAX=F
End If
If F=4090
PIC_POINTER=Val(Lword(3,A$))
End If
End If
Until Eof(3)
Close 3
Amos To Front
Load "FrameInfo.bin",43
'Open In 3,FRAMES_FILE$
'CPOS=86 : EPOS=Lof(3)
'C=1 : N=Start(43)+4
'Repeat
' Loke N,CPOS : N=N+4
' Pof(3)=CPOS+4
' CPOS=CPOS+6+Elword(Input$(3,2))
' Pof(3)=CPOS
'Until CPOS=>EPOS
'Save "FrameInfo.bin",43
'Close 3
End Proc
Procedure NEWFRAME_RESET
On Error Proc INEXT_ERRORTRAP
FRAMES_LOAD$=""
End Proc
Procedure NEWFRAME_SET[CHAR,WHICH,RV]
'On Error Proc INEXT_ERRORTRAP
FP=Deek(FRAME_PTR+1024+WHICH*2)
FM=Deek(FRAME_PTR+9216+FP)
If Not RV
Doke FRAME_PTR+CHAR*4,0
CB=0
Else
Doke FRAME_PTR+CHAR*4,FM
CB=FM
End If
OSET=Deek(FRAME_PTR+CHAR*4+2)
Doke FRAME_PTR+CHAR*4+2,WHICH
CB=Deek(FRAME_PTR+9218+FP+(CB*2))
FRAME_NEWCHECK[CB]
C=Deek(FRAME_PTR+9218+FP+((FM+1)*2))
If C=2
CB=Hrev(CB)
Else If C=3
CB=Vrev(CB)
End If
Bob CHAR,,,CB
'FRAME_DIDCHANGE(CHAR)=True
End Proc[OSET]
Procedure NEWFRAME_LOOP[CHAR,RV]
On Error Proc INEXT_ERRORTRAP
NEWFRAME_MOVE[CHAR,RV]
If Param
FS=Deek(FRAME_PTR+CHAR*4+2)
NEWFRAME_SET[CHAR,FS,RV]
End If
End Proc
Procedure NEWFRAME_MOVE[CHAR,RV]
On Error Proc INEXT_ERRORTRAP
CF=Deek(FRAME_PTR+CHAR*4)
FS=Deek(FRAME_PTR+CHAR*4+2)
FP=Deek(FRAME_PTR+1024+FS*2)
FM=Deek(FRAME_PTR+9216+FP)
C=Deek(FRAME_PTR+9218+FP+((FM+1)*2))
If RV
If CF=0
EF=True
Else
CF=CF-1
End If
Else
If CF=FM
EF=True
Else
CF=CF+1
End If
End If
Doke FRAME_PTR+CHAR*4,CF
CB=Deek(FRAME_PTR+9218+FP+(CF*2))
FRAME_NEWCHECK[CB]
If C=2
CB=Hrev(CB)
Else If C=3
CB=Vrev(CB)
End If
Bob CHAR,,,CB
End Proc[EF]
Procedure NEWFRAME_CHANGE[CHAR]
On Error Proc INEXT_ERRORTRAP
FS=Deek(FRAME_PTR+CHAR*4+2)
FP=Deek(FRAME_PTR+1024+FS*2)
FM=Deek(FRAME_PTR+9216+FP)
C=Deek(FRAME_PTR+9218+FP+((FM+1)*2))
End Proc[C=1]
Procedure NEWFRAME_CURRFRAMESET[CHAR]
FS=Deek(FRAME_PTR+CHAR*4+2)
End Proc[FS]
Procedure NEWFRAME_FULLREQUEST
S=Start(43) : SNOPEN=False
Open In 3,FRAMES_FILE$
For J=1 To Len(FRAMES_LOAD$) Step 2
WHICH=Elword(Mid$(FRAMES_LOAD$,J,2))
FP=Deek(FRAME_PTR+1024+WHICH*2)
FM=Deek(FRAME_PTR+9216+FP)
For I=0 To FM
F=Deek(FRAME_PTR+9218+FP+(I*2))
If Peek(Start(26)+F)<>255
If SNOPEN=False
T=Screen
Screen Open 6,320,200,64,Lowres
Screen Hide 6
SNOPEN=True
End If
A=Leek(S+F*4)
If A>0
POS=Leek(Start(43)+F*4)
Pof(3)=POS
SW=Elword(Input$(3,2))
SH=Elword(Input$(3,2))
SS=Elword(Input$(3,2))
Reserve As Work 12,SS
Sload 3 To 12,SS
Unpack 12,0,0
Erase 12
'Unpack A+6,0,0
Get Bob F,0,0 To SW,SH
Hot Spot F,$12
Poke Start(26)+F,255
End If
End If
Poke Start(25)+F,255
Next
Next
Close 3
If SNOPEN
Screen Close 6
Screen T
End If
End Proc
Procedure NEWFRAME_GRABSET[WHICH]
On Error Proc INEXT_ERRORTRAP
FRAMES_LOAD$=FRAMES_LOAD$+Elword$(WHICH)
End Proc
Procedure FRAMES_CHECKSETUP
On Error Proc INEXT_ERRORTRAP
Reserve As Work 25,4096
End Proc
Procedure FRAME_NEWCHECK[F]
On Error Proc INEXT_ERRORTRAP
If Peek(Start(26)+F)<>255
A=Leek(Start(43)+F*4)
If A>0
T=Screen
Screen Open 6,320,200,64,Lowres
Screen Hide 6
Open In 3,FRAMES_FILE$
POS=Leek(Start(43)+F*4)
D=(D+5) mod 191
Pof(3)=POS
SW=Elword(Input$(3,2))
SH=Elword(Input$(3,2))
SS=Elword(Input$(3,2))
Reserve As Work 12,SS
Sload 3 To 12,SS
Close 3
Unpack 12,0,0
Erase 12
'Unpack A+6,0,0
Get Bob F,0,0 To SW,SH
Hot Spot F,$12
Poke Start(26)+F,255
Screen Close 6
Screen T
End If
End If
Poke Start(25)+F,255
End Proc
Procedure FRAMES_HOUSEKEEPING
On Error Proc INEXT_ERRORTRAP
S=Start(25)
For I=1 To 4095
If Peek(S+I)=0
If Peek(Start(26)+I)=255
Del Bob I : Ins Bob I
Poke Start(26)+I,0
End If
End If
Next
End Proc
Procedure DPOINTER[X,Y]
Shared PIC_POINTER
Paste Bob X,Y,PIC_POINTER
End Proc
Procedure LEVEL_CHECK
On Error Proc INEXT_ERRORTRAP
If LEVEL_LOADNOW$<>""
MAP_FRONTCLOSE
LEVEL_LOAD[LEVEL_LOADNOW$]
LEVEL_LOADNOW$=""
End If
End Proc
Procedure LEVEL_LOAD[FILE$]
On Error Proc INEXT_ERRORTRAP
Shared MUS_NOPLAY,PIC_POINTER
Open In 4,"levels/"+FILE$
Set Input 10,-1
Bob Off
If EFFECT_SETTINGS(0)>0
Trap Del Block 200
End If
EFFECT_SETTINGS(0)=0
CONTROLLOCK=False
WALKTHRUWALLS=False
SCRIPT_PREP
MAP_ZONERESET
FRAMES_CHECKSETUP
NEWFRAME_RESET
BLACKSCREEN=True
CZ=0 : MP$=""
Repeat
Line Input #4,A$
B$=A$-" "
If B$<>""
If B$="|MAPZ|"
MD=0
Else If B$="|CHARZ|"
MD=1
Else If B$="|ZONEZ|"
MD=2
Else If B$="|COMMENTZ|"
MD=3
Else If B$="|EFFECTZ|"
MD=4
Else If B$="|MUSIL|"
MD=5
Else If B$="|NAMEZ|"
MD=6
Else If B$="|DELAYZ|"
NOFRONTFADE=True
Else
If MD=0
MP$=Right Trim$(A$)
Else If MD=1
SC$="scripts/"+Lword(1,A$)
X=Val(Lword(2,A$))
Y=Val(Lword(3,A$))
F=Val(Lword(4,A$))
V=Val(Lword(5,A$))
S=Val(Lword(6,A$))
'FRAMES_CHECK[F]
CHAR_SET[SC$,X,Y,F,V,S]
Else If MD=2
A=Lwords(A$)
TP$=Upper$(Lword(1,A$))
If TP$="STOP"
T=0
Else If TP$="SLOW"
T=1
Else If TP$="LEVEL"
T=2
Else If TP$="FIGHT"
T=3
Else If TP$="LABELJUMP"
T=4
End If
X1=Val(Lword(2,A$))
Y1=Val(Lword(3,A$))
X2=Val(Lword(4,A$))
Y2=Val(Lword(5,A$))
MAP_ZONESET[CZ,X1,Y1,X2,Y2,T]
If A>5
If A>9 : A=9 : End If
For I=6 To A
MAP_ZONESETVAR[CZ,I-6,Val(Lword(I,A$))]
Next
End If
Inc CZ
Else If MD=4
A=Lwords(A$)-1
If A>-1
For I=0 To A
EFFECT_SETTINGS(I)=Val(Lword(I+1,A$))
Next
End If
Else If MD=5
If A$<>""
A$="mods/"+A$
If Exist(A$)=True
NEWMOD$=Upper$(A$)
Else
INEXT_ERROR["Cannot Find .mod File","",A$]
End If
End If
Else If MD=6
CHAR_NAME$=Right Trim$(A$)
End If
End If
If MD<>0 and MP$<>""
MAP_SCREENLOAD["maps/"+MP$] : MP$=""
End If
End If
Until Eof(4)
Close 4
NEWFRAME_FULLREQUEST
If Exist("scripts/globalscript.script")
CHAR_SET["scripts/globalscript.script",-49,-49,0,0,0]
End If
If Not MUS_NOPLAY
If NEWMOD$<>CURRMOD$
For I=63 To 0 Step -4
Ptm Volume I : Wait Vbl
Next
Ptm Stop : Erase 33
If NEWMOD$<>""
If Not Exist("RPG:"+NEWMOD$)
INEXT_ERROR["Unable to find MOD File",NEWMOD$,"In Mods Directory"]
End If
Ptm Load "RPG:"+NEWMOD$,33 : Ptm Volume 63
Ptm Play 33
End If
CURRMOD$=NEWMOD$
End If
End If
If LEVEL_SKIPCHARXY
Bob 0,CHAR_XPOS,CHAR_YPOS,
Else
CHAR_XPOS=X Bob(0) : CHAR_YPOS=Y Bob(0)
End If
LEVEL_SKIPCHARXY=False
EFFECT_SETUP
CLR_SETUP
FRAME_NEWCHECK[PIC_POINTER]
FRAMES_HOUSEKEEPING
CURRLEVEL$=FILE$
DISPLAY_SHOW=True
If Not NOFRONTFADE
MAP_FRONTFADEIN
End If
NOFRONTFADE=False
End Proc
Procedure SCRNSAVER
On Error Proc INEXT_ERRORTRAP
If SSVTIMER=0
SSVTIMER=Timer+9000
Else
If Joy(1)>0
SSVTIMER=Timer+9000
Else
If Timer>SSVTIMER
BLUEUP=True : GREENUP=True : REDUP=True
SC=-1
Repeat
Inc SC
Trap Screen SC
Until Errtrap>0 or SC=8
If SC<8
S=Screen
SW=320 : SH=200 : RES=Lowres
Screen Open SC,SW,SH,2,RES : Flash Off : Curs Off : Cls 0
Palette $0,$333
Reserve As Work 256,176
For I=0 To 3
Repeat
DX=32757+Rnd(20)
DY=32757+Rnd(20)
Until DX<>32767 and DY<>32767
Doke Start(256)+(I*4),DX
Doke Start(256)+(I*4)+2,DX
SX=Rnd(SW-1) : SY=Rnd(SH-1)
For J=0 To 9
Doke Start(256)+16+(J*8)+(I*4),SX
Doke Start(256)+18+(J*8)+(I*4),SY
Next
Next
Repeat
For J=0 To 1
Ink 1-J
For I=0 To 3
SX=Deek(Start(256)+16+(J*144)+I*4)
SY=Deek(Start(256)+18+(J*144)+I*4)
If I=0
Gr Locate SX,SY
OSX=SX : OSY=SY
Else
Draw To SX,SY
End If
Next
Draw To OSX,OSY
Next
Copy Start(256)+16,Start(256)+160 To Start(256)+32
For I=0 To 3
SX=Deek(Start(256)+32+I*4)
SY=Deek(Start(256)+34+I*4)
DX=Deek(Start(256)+I*4)-32767
DY=Deek(Start(256)+2+I*4)-32767
SX=SX+DX : SY=SY+DY
CHDIR=False
If SX<1
SX=1 : CHDIR=True
Else If SX>SW-2
SX=SW-2 : CHDIR=True
End If
If SY<1
SY=1 : CHDIR=True
Else If SY>SH-2
SY=SH-2 : CHDIR=True
End If
Doke Start(256)+16+I*4,SX
Doke Start(256)+18+I*4,SY
If CHDIR
Repeat
DX=32757+Rnd(20)
DY=32757+Rnd(20)
Until DX<>32767 and DY<>32767
Doke Start(256)+I*4,DX
Doke Start(256)+2+I*4,DY
End If
Next
C=Colour(1)
R=(C and $F00)/256
G=(C and $F0)/16
B=C and $F
If BLUEUP
B=B+1
Else
B=B-1
End If
If B=15 or B=3
BLUEUP= Not BLUEUP
If GREENUP
G=G+1
Else
G=G-1
End If
If G=15 or G=3
GREENUP= Not GREENUP
If REDUP
R=R+1
Else
R=R-1
End If
If R=15 or R=3
REDUP= Not REDUP
End If
End If
End If
C=R*256+G*16+B
Colour 1,C
Beam Wait VB_LINE
Until Joy(1)<>0 or Inkey$<>""
SSVTIMER=Timer+9000
Screen Close SC
Screen S
End If
End If
End If
End If
End Proc
Procedure SCRNSAVER_KILL
SSVTIMER=Timer+9000
End Proc
Procedure XPK_BANKUNPACK[FILE$,BANK]
On Error Proc INEXT_ERRORTRAP
If Instr(FILE$,":")=0
FILE$=Dir$+FILE$
End If
XPK_USERBASE=$80005850
XPK_UNPACK=-48
XPK_EXAMINE=-36
XPK_INNAME=XPK_USERBASE+$1
XPK_OUTBUF=XPK_USERBASE+$12
XPK_OUTBUFLEN=XPK_USERBASE+$21
For I=12 To 400
If Length(I)=0 and I<>BANK
B=I : I=400
End If
Next
Reserve As Work B,256
FILE$=FILE$+Chr$(0)
Lib Open 1,"xpkmaster.library",0
CNT=0
Repeat
A$=Ellong$(XPK_INNAME)+Ellong$(Varptr(FILE$))
A$=A$+String$(Chr$(0),9)
Areg(0)=Start(B) : Areg(1)=Varptr(A$)
A=Lib Call(1,XPK_EXAMINE)
CNT=CNT+1
'Print A
Until A=0 or CNT=20
If CNT=20
INEXT_ERROR["","XPK Unpacking Error",""]
End If
OSIZE=Leek(Start(B)+4)
CNT=0
Repeat
Erase BANK : Reserve As Work BANK,OSIZE+256
A$=Ellong$(XPK_INNAME)+Ellong$(Varptr(FILE$))
A$=A$+Ellong$(XPK_OUTBUF)+Ellong$(Start(BANK)-12)
A$=A$+Ellong$(XPK_OUTBUFLEN)+Ellong$(OSIZE+268)
A$=A$+String$(Chr$(0),9)
Areg(0)=Varptr(A$)
A=Lib Call(1,XPK_UNPACK)
CNT=CNT+1
Until A=0 or CNT=20
If CNT=20
INEXT_ERROR["","XPK Unpacking Error",""]
End If
Bank Shrink BANK To OSIZE-12
Lib Close 1
End Proc
Procedure SOUND_PLAY[FILE$,VOC,FREQ,BANK]
On Error Proc INEXT_ERRORTRAP
If Exist(FILE$)
Open In 6,FILE$
Erase BANK
Reserve As Chip Work BANK,Lof(6)
Sload 6 To BANK,Lof(6)
Close 6
Dme Sam Raw VOC,Start(BANK)+72,Length(BANK)-72,FREQ
Repeat : Until Sam Swapped(0)<>0
End If
End Proc
Procedure GAME_SAVE[FILENAME$]
On Error Proc INEXT_ERRORTRAP
If FILENAME$<>""
If Upper$(Right$(FILENAME$,5))<>".GAME"
FILENAME$=FILENAME$+".game"
End If
Open Out 4,FILENAME$
Print #4,"RPGSAVE!";Chr$(10);
'Char & Map Positions
Print #4,CURRLEVEL$;Chr$(10);
Print #4,Ellong$(CHAR_XPOS);Ellong$(CHAR_YPOS);
Print #4,Ellong$(MAP_XPOS);Ellong$(MAP_YPOS);
Print #4,Ellong$(CONTROLLOCK);Ellong$(WALKTHRUWALLS);
'Global Variables
For I=0 To 255
Print #4,Ellong$(Leek(Start(58)+(I*4)));
Next
'Enemy Positions, Script Positions, Variables
Print #4,Ellong$(SCR_MAX);
For I=0 To SCR_MAX
Print #4,Ellong$(X Bob(I));Ellong$(Y Bob(I));
Print #4,Ellong$(Leek(Start(67)+(I*12)+8));
For J=0 To 63
Print #4,Ellong$(Leek(Start(68)+(I*256)+(J*4)));
Next
For J=0 To 3
Print #4,Ellong$(SCRIPT_CURRCOMMAND(I,J));
Next
Next
'Ratings & Items
For I=0 To 6
Print #4,Ellong$(RATINGS(I));
Next
MZ=-1
For I=0 To 261
If ITEMHAVE(I)>0 : MZ=I : End If
Next
Print #4,Ellong$(MZ);
For I=0 To MZ
Print #4,Ellong$(ITEMHAVE(I));
Next
Close 4
End If
End Proc
Procedure GAME_LOAD[FILENAME$]
On Error Proc INEXT_ERRORTRAP
If FILENAME$<>"" : If Exist(FILENAME$)
NOFRONTFADE=True
Open In 5,FILENAME$
Set Input 10,-1
Line Input #5,A$
If A$="RPGSAVE!"
'Char & Map Positions
Line Input #5,CURRLEVEL$
LEVEL_LOADNOW$=CURRLEVEL$
LEVEL_CHECK
CHAR_XPOS=Ellong(Input$(5,4))
CHAR_YPOS=Ellong(Input$(5,4))
MAP_XPOS=Ellong(Input$(5,4))
MAP_YPOS=Ellong(Input$(5,4))
CONTROLLOCK=Ellong(Input$(5,4))
WALKTHRUWALLS=Ellong(Input$(5,4))
'Global Variables
For I=0 To 255
Loke(Start(58)+(I*4)),Ellong(Input$(5,4))
Next
'Enemy Positions, Script Positions, Variables
SCR_MAX=Ellong(Input$(5,4))
For I=0 To SCR_MAX
X=Ellong(Input$(5,4)) : Y=Ellong(Input$(5,4)) : Bob I,X,Y,
Loke Start(67)+(I*12)+8,Ellong(Input$(5,4))
For J=0 To 63
Loke Start(68)+(I*256)+(J*4),Ellong(Input$(5,4))
Next
For J=0 To 3
SCRIPT_CURRCOMMAND(I,J)=Ellong(Input$(5,4))
Next
Next
'Ratings & Items
For I=0 To 6
RATINGS(I)=Ellong(Input$(5,4))
Next
For I=0 To 255
ITEMHAVE(I)=0
Next
MZ=Ellong(Input$(5,4))
For I=0 To MZ
ITEMHAVE(I)=Ellong(Input$(5,4))
Next
MAP_FRONTFADEIN
End If
Close 5
End If : End If
End Proc
Procedure INEXT_ERRORTRAP
'Error Errn
A$=Resource$(-(5001+Errn))
INEXT_ERROR["Internal Error","",A$]
End Proc
Procedure INEXT_ERROR[L1$,L2$,L3$]
Shared ERR_FILE$
Erase All
Amos To Back
Amos Lock
Load ERR_FILE$
Gui Sensitive Off
Gui Open 0,1,20
'Gui Paste Bob 1,4,20
Gui Set 0,1,0,Varptr(L1$)
Gui Set 0,2,0,Varptr(L2$)
Gui Set 0,3,0,Varptr(L3$)
T=Timer+200
Repeat
A=Gui Event
Gui Wait Vbl
Until Timer>T or A=-1 or A=4
A=Gui Close(0)
Erase All
Amos Unlock
End
End Proc
Procedure FULLINTRO
Hide
_INTRO
T=Timer+200
Repeat : Until Fire(1) or Timer>T
_INTRO_CLOSE
_MAINMENU
C=Param
End Proc[C]
Procedure _INTRO
Load "MainMenu_1.spk",512
Load "MainMenu_2.spk",513
Unpack 512 To 6 : Screen Hide 6 : Erase 512
Screen Open 7,320,200,4096,Lowres : Flash Off : Curs Off : Cls 0
Get Palette 6
For I=0 To 99
Screen Copy 6,0,I*2,320,(I*2)+1 To 7,0,I*2
Screen Copy 6,0,199-(I*2),320,200-(I*2) To 7,0,199-(I*2)
If(I and 3)=0 : Wait Vbl : End If
Next
Screen Close 6
End Proc
Procedure _INTRO_CLOSE
Screen 7
For I=0 To 99
Cls 0,0,I*2 To 320,(I*2)+1
Cls 0,0,199-(I*2) To 320,200-(I*2)
If(I and 3)=0 : Wait Vbl : End If
Next
Screen Close 7
End Proc
Procedure _MAINMENU
Dim BCOORDS(3,3)
For X=0 To 3
For Y=0 To 3
Read BCOORDS(X,Y)
Next
Next
Unpack 513 To 6 : Screen Hide 6 : Erase 513
Screen Open 7,320,200,16,Lowres : Flash Off : Curs Off : Cls 0
Screen To Front 7
For I=0 To 15 : Colour I,0 : Next
Screen Copy 6 To 7
Fade 2 To 6 : Screen Close 6
Wait 30
CSEL=0
Repeat
Ink 1
For I=0 To 3
Box BCOORDS(I,0),BCOORDS(I,1) To BCOORDS(I,2),BCOORDS(I,3)
Next
Ink 13 : Box BCOORDS(CSEL,0),BCOORDS(CSEL,1) To BCOORDS(CSEL,2),BCOORDS(CSEL,3)
Repeat : A=Joy(1) : Until A<>0
If Btst(0,A)
Add CSEL,-1,0 To 3
Else If Btst(1,A)
Add CSEL,1,0 To 3
End If
Repeat : Until Joy(1)=0
Until Btst(4,A)
Fade 2 : Wait 30
'
Data 98,75,211,87
Data 98,87,211,100
Data 98,100,211,113
Data 98,113,211,125
'
Screen Close 7
End Proc[CSEL]
Procedure FMV[FILE$]
Open In 1,FILE$
A=Frame Load(1 To 50)
A=Frame Play(50,1,4)
Double Buffer : Autoback 0
Pof(1)=0
L=Lof(1)
Reserve As Work 50,60000
FRAME=0
Repeat
T=Timer+3
A=Frame Play(Start(50),Frame Load(1 To Start(50)))
Screen Swap : Wait Vbl
FRAME=FRAME+1
Repeat : Until Timer>T
Until FRAME=450 or Fire(1)
Screen Close 4
Erase 50
Close 1
End Proc
Procedure CREDITS[WHICH]
If WHICH=0
A$="Credits_1.spk"
Else If WHICH=1
A$="Credits_2.spk"
Else If WHICH=2
A$="Credits_Demo.spk"
End If
Wait 30
Load A$,512
Unpack 512 To 6 : Screen Hide 6
Screen Open 7,320,200,4096,Lowres : Flash Off : Curs Off : Cls 0
Get Palette 6
For I=0 To 99
Screen Copy 6,0,I*2,320,(I*2)+1 To 7,0,I*2
Screen Copy 6,0,199-(I*2),320,200-(I*2) To 7,0,199-(I*2)
If(I and 2)=0 : Wait Vbl : End If
Next
Screen Close 6
T=Timer+200
Repeat : Until Timer>T or Fire(1)
Screen 7
For I=0 To 99
Cls 0,0,I*2 To 320,(I*2)+1
Cls 0,0,199-(I*2) To 320,200-(I*2)
If(I and 2)=0 : Wait Vbl : End If
Next
Screen Close 7
Wait 30
If WHICH<>2
'scroll text up
Screen Open 4,320,216,4,Lowres : Flash Off : Curs Off : Cls 0
Screen Display 4,128,50,320,200
Double Buffer : Autoback 0
Palette $0,$333,$666,$FFF
FONT_FIND["XEN.font/8"]
Set Font Param
For I=0 To 3
MENU_COLORS(I)=I
Next
Gr Writing 0
NOREAD=False : NRCOUNT=24
Def Scroll 1,0,0 To 320,216,0,-1
Repeat
If NOREAD=False
Read A$
Else
NRCOUNT=NRCOUNT-1
End If
If A$="!" : A$="" : NOREAD=True : End If
CNTR=160-(Text Length(A$)/2)
AA_FONT[CNTR,209,A$]
For I=7 To 0 Step -1
Screen Swap : Wait 4
Screen Copy Physic To Logic
Scroll 1
Next
Until NRCOUNT=0
End If
Wait 30
Data "Final Existence"
Data ""
Data "INextSoft's First Full Role Playing Game"
Data "","",""
Data "Programmed By","","John Bintz"
Data "",""
Data "Graphics By","","John Bintz"
Data "",""
Data "Music From","","The AMOS PD CD"
Data "",""
Data "Beta Testing By",""
Data "John Bintz"
Data "Jeremy Templeton"
Data "Alex Fazenbaker"
Data "Justin Bintz"
Data "",""
Data "Written in Amos Professional V2.0"
Data "",""
Data "Internext Software EMail Address"
Data ""
Data "uv334@victoria.tc.ca"
Data "",""
Data "Thanks To"
Data ""
Data "Becky Trout"
Data "The Fazenbakers"
Data "The Amos Mailing List"
Data "Won Novalis"
Data "Dragonfire Internet Services"
Data "François Lionet and Mandarin Software"
Data "Pietro Ghizzoni"
Data "","","","","","","","","",""
Data "Internext Software Will Return"
Data "In 1999"
Data ""
Data "!"
End Proc
'i own everything, for I am Bill Gates, ruler of the Internet.
